2009-12-04 00:11:15 -05:00
PSNACT ; BIR / DMA & WRT - inquiries by VAPN , CMOP ID , or NDC ; 07 / 02 / 03 14 : 01
;; 4.0 ; NATIONAL DRUG FILE ; * * 22 , 35 , 47 , 62 , 65 , 70 * * ; 30 Oct 98
;
; Reference to ^ PS ( 50.606 supported by DBIA #2174
;
I ' $ D ( IORVON ) S X = "IORVON;IORVOFF" D ENDR ^ % ZISS
K DIC , DIR F ZXX = 0 : 0 W ! D TEXT , ASKIT Q : $ D ( DIRUT )
K QUIT , DIR , DIC , OLDDA , PROMPT , J , I , IEN , PPP , Y , Y1 , Y3 , Y5 , Y6 , Y7 , Z0 , Z1 , Z3 , Z5 , Z6 , Z7 , ZA , ZXX , ASK , NDX , SIE , PSN , PSN1 , MORE , SIE1 , PMIS , QQQ , ENG , MAP
Q
TEXT W ! , "This option allows you to lookup NDF file information three ways (VA Product" , ! , "Name, NDC, or CMOP ID number)." , !
Q
ASKIT S DIR ( 0 ) = "SA^VA:VA PRODUCT;N:NDC;C:CMOP ID" , DIR ( "A" ) = "LOOKUP BY (VA) PRODUCT, (N)DC, OR (C)MOP ID ? " D ^ DIR G END : $ D ( DIRUT ) S ASK = Y ( 0 )
I ASK = "NDC" D NDC
I ASK = "VA PRODUCT" D LISTNDC
I ASK = "CMOP ID" D CMOP
Q
ENTER K QQQ S DA = + Y , Y1 = ^ PSNDF ( 50.68 , DA , 1 ) , Y3 = ^ ( 3 ) , Y7 = $ G ( ^ ( 7 ) ) , Y5 = $ G ( ^ ( 5 ) ) , Y6 = $ G ( ^ PSNDF ( 50.68 , DA , 6 , 1 , 0 ) ) , QQQ = $ P ( Y1 , "^" , 5 ) D GCN D
. W @ IOF , ! , "VA Product Name: " , $ P ( Y ( 0 ) , "^" ) , $ $ DT ( $ P ( Y7 , "^" , 3 ) )
. W ! , "VA Generic Name: " , $ P ( ^ PSNDF ( 50.6 , + $ P ( Y ( 0 ) , "^" , 2 ) , 0 ) , "^" ) , ! , "Dose Form: " , $ P ( ^ PS ( 50.606 , + $ P ( Y ( 0 ) , "^" , 3 ) , 0 ) , "^" ) , " Strength: " , $ P ( Y ( 0 ) , "^" , 4 ) , " Units: " , $ P ( $ G ( ^ PS ( 50.607 , + $ P ( Y ( 0 ) , "^" , 5 ) , 0 ) ) , "^" )
. W ! , "National Formulary Name: " , $ P ( Y ( 0 ) , "^" , 6 ) , ! , "VA Print Name: " , $ P ( Y1 , "^" ) , ! , "VA Product Identifier: " , $ P ( Y1 , "^" , 2 ) , " Transmit to CMOP: " , $ S ( $ P ( Y1 , "^" , 3 ) : "Yes" , 1 : "No" )
. W " VA Dispense Unit: " , $ P ( $ G ( ^ PSNDF ( 50.64 , + $ P ( Y1 , "^" , 4 ) , 0 ) ) , "^" )
. W ! , "PMIS: " , PMIS , ! , "Active Ingredients: " S K = 0 F S K = $ O ( ^ PSNDF ( 50.68 , DA , 2 , K ) ) Q : ' K ! ( $ G ( QUIT ) ) S X = ^ ( K , 0 ) , ING = ^ PS ( 50.416 , K , 0 ) S : $ P ( ING , "^" , 2 ) ING = ^ PS ( 50.416 , $ P ( ING , "^" , 2 ) , 0 ) D
. . D : ( $ Y + 5 ) > IOSL & ( ' $ G ( QUIT ) ) HANG Q : $ G ( QUIT ) W ? 23 , $ P ( ING , "^" ) , " Strength: " , $ P ( X , "^" , 2 ) , " Units :" , $ P ( $ G ( ^ PS ( 50.607 , + $ P ( X , "^" , 3 ) , 0 ) ) , "^" ) , !
. Q : $ G ( QUIT ) W ! , "Primary VA Drug Class: " , $ P ( $ G ( ^ PS ( 50.605 , + Y3 , 0 ) , "Unknown" ) , "^" ) , ! , "Secondary VA Drug Class: " S K = 0 F S K = $ O ( ^ PSNDF ( 50.68 , DA , 4 , K ) ) Q : ' K W ? 26 , $ P ( $ G ( ^ PS ( 50.605 , + K , 0 ) , "Unknown" ) , "^" ) , !
. W ! , "CS Federal Schedule: " _ $ S ( $ P ( $ G ( ^ PSNDF ( 50.68 , DA , 7 ) ) , "^" ) ] "" : $ P ( ^ PSNDF ( 50.68 , DA , 7 ) , "^" ) , 1 : "" )
. W ! , "National Formulary Indicator: " W : $ P ( Y5 , "^" ) = 1 "Yes" W : $ P ( Y5 , "^" ) = 0 "No"
. W ! , "National Formulary Restriction: " , ! , $ P ( Y6 , "^" )
. I $ G ( ^ PSNDF ( 50.68 , DA , 8 ) ) W ! , "Exclude Drg-Drg Interaction Ck: Yes (No check for Drug-Drug Interactions)"
Q
K DA , DIE , DIE , DIRUT , DR , ING , K , OLDDA , X , Y , Y1 , Y3 , Y7 Q
;
NDC ; OR UPN
K PROMPT S DIR ( 0 ) = "SA^N:NDC;U:UPN" , DIR ( "A" ) = "NDC (N) or UPN (U) ? " D ^ DIR G END : $ D ( DIRUT ) S PROMPT = Y ( 0 )
I PROMPT = "NDC" S DIR ( 0 ) = "F" , DIR ( "A" ) = "Enter NDC with or without Dashes (-)" D ^ DIR G END : $ D ( DIRUT ) D : X [ "-" PAD S DIC = 50.67 , DIC ( 0 ) = "EQZN" , D = PROMPT D IX ^ DIC Q : Y < 0 S DA = + Y , NDF = Y ( 0 ) D LKNDC
I PROMPT = "UPN" S DIC = 50.67 , DIC ( 0 ) = "AEQZN" , DIC ( "A" ) = "Select " _PROMPT _ ":" _ " " , D = PROMPT D IX ^ DIC Q : Y < 0 S DA = + Y , NDF = Y ( 0 ) D LKNDC
Q
LKNDC W @ IOF , ! , "NDC: " , $ P ( NDF , "^" , 2 ) , $ $ DT ( $ P ( NDF , "^" , 7 ) ) , " UPN: " , $ P ( NDF , "^" , 3 ) , ! , "VA Product Name: " , $ P ( ^ PSNDF ( 50.68 , $ P ( NDF , "^" , 6 ) , 0 ) , "^" ) , ! , "Manufacturer: " , $ P ( $ G ( ^ PS ( 55.95 , + $ P ( NDF , "^" , 4 ) , 0 ) ) , "^" ) , " Trade Name: " , $ P ( NDF , "^" , 5 ) , ! , "Route: "
S K = 0 F S K = $ O ( ^ PSNDF ( 50.67 , DA , 1 , K ) ) Q : ' K W $ P ( ^ ( K , 0 ) , "^" ) , " "
W ! , "Package Size: " , $ P ( ^ PS ( 50.609 , $ P ( NDF , "^" , 8 ) , 0 ) , "^" ) , " Package Type: " , $ P ( ^ PS ( 50.608 , $ P ( NDF , "^" , 9 ) , 0 ) , "^" )
S ZA = $ P ( NDF , "^" , 6 ) D ENTER1
Q
END K DA , DA , DIC , DIE , DIR , DR , IN , ING , J , K , L , NEW , NDF , OLD , OLDDA , PROMPT , X , Y , Y1 , Y3 , Y7 , ^ TMP ( $ J ) Q
Q
;
PRODI ; INQUIRE INTO 50.68
F S DIC = "^PSNDF(50.68," , DIC ( 0 ) = "AEQM" D ^ DIC Q : Y < 0 S DA = + Y D EN ^ DIQ
K DA , DIC , X , Y Q
;
NDCI ; INQUIRE INTO 50.67
S DIR ( 0 ) = "SA^N:NDC;U:UPN;T:TRADE;P:PRODUCT" , DIR ( "A" ) = "NDC (N), UPN (U), Trade name (T), or Product (P) " D ^ DIR G END : $ D ( DIRUT ) S PROMPT = Y ( 0 ) G LISTNDC : PROMPT [ "PRO" , LISTNDC1 : PROMPT = "NDC" I PROMPT [ "T" S PROMPT = "T"
F S DIC = "^PSNDF(50.67," , DIC ( 0 ) = "AEQZS" , DIC ( "A" ) = "Select " _PROMPT S : PROMPT = "T" DIC ( "A" ) = DIC ( "A" ) _ "rade name" S DIC ( "A" ) = DIC ( "A" ) _ " " , D = PROMPT D IX ^ DIC Q : Y < 0 S DA = + Y D EN ^ DIQ
K DA , DIC , DIR , PROMPT , X , Y Q
;
LINK ; LINK NDCS OR UPNS
S DIR ( 0 ) = "SA^N:NDC;U:UPN" , DIR ( "A" ) = "NDC (N) or UPN (U) " , DIR ( "B" ) = "NDC" D ^ DIR G END : $ D ( DIRUT ) S PROMPT = Y ( 0 )
F Q : $ D ( DIRUT ) ! ( Y < 0 ) S DIC = 50.67 , DIC ( 0 ) = "AEQZ" , DIC ( "A" ) = "Enter Current " _PROMPT _ " " , D = PROMPT D IX ^ DIC Q : Y < 0 S DA = + Y , OLD = $ P ( Y ( 0 ) , "^" , $ S ( PROMPT = "NDC" : 2 , 1 : 3 ) ) D
. K DIR S DIR ( 0 ) = "F^" _ $ S ( PROMPT = "NDC" : "12:12" , 1 : "1:40" ) _ "^W:$D(^PSNDF(50.67,PROMPT,X)) !!," "That " _PROMPT _ " already exists" ",! K:$D(^PSNDF(50.67,PROMPT,X)) X" , DIR ( "A" ) = "Enter a new " _PROMPT _ " " D ^ DIR K DIR Q : $ D ( DIRUT ) S NEW = Y
. I PROMPT = "NDC" D
. . S IN = $ O ( ^ PSNDF ( 50.67 , DA , 2 , "B" , NEW , 0 ) ) I IN S DIR ( 0 ) = "Y" W ! , "Those NDCs are already linked" S DIR ( "A" ) = "Do you want to unlink them " D ^ DIR Q : $ D ( DIRUT ) Q : ' Y
. . I IN S DA ( 1 ) = DA , DA = IN , DIE = "^PSNDF(50.67," _DA ( 1 ) _ ",2," , DR = ".01///@;" D ^ DIE W ! , "Unlinked" , ! Q
. . I ' IN S DIE = "^PSNDF(50.67," , DR = "1////" _NEW D ^ DIE K DD , DO S DA ( 1 ) = DA , DIC = "^PSNDF(50.67," _DA ( 1 ) _ ",2," , DIC ( 0 ) = "L" , DLAYGO = 50.67 , DIC ( "P" ) = $ P ( ^ DD ( 50.67 , 11 , 0 ) , "^" , 2 ) , X = OLD D ^ DIC W ! , "Linked" , ! Q
. I PROMPT = "UPN" D
. . S IN = $ O ( ^ PSNDF ( 50.67 , DA , 3 , "B" , NEW , 0 ) ) I IN S DIR ( 0 ) = "Y" W ! , "Those UPNs are already linked" S DIR ( "A" ) = "Do you want to unlink them " D ^ DIR Q : $ D ( DIRUT ) Q : ' Y
. . S DA ( 1 ) = DA , DA = IN , DIE = "^PSNDF(50.67," _DA ( 1 ) _ ",3," , DR = ".01///@;" D ^ DIE W ! , "Unlinked" , ! Q
. . I ' IN S DIE = "^PSNDF(50.67," , DR = "1////" _NEW D ^ DIE K DD , DO S DA ( 1 ) = DA , DIC = "^PSNDF(50.67," _DA ( 1 ) _ ",3," , DIC ( 0 ) = "L" , DLAYGO = 50.67 , DIC ( "P" ) = $ P ( ^ DD ( 50.67 , 12 , 0 ) , "^" , 2 ) , X = OLD D ^ DIC W ! , "Linked" , ! Q
G LINK
;
LISTNDC ; LOOK UP NDCS BY PRODUCT
K L , DA , ^ TMP ( $ J ) , DIC
S DIC = 50.68 , DIC ( 0 ) = "AQEMZ" D ^ DIC G END : Y < 0 S IEN = + Y D ENTER F SIE = 0 : 0 S SIE = $ O ( ^ PSNDF ( 50.68 , "ANDC" , IEN , SIE ) ) Q : ' SIE ! ( $ G ( QUIT ) ) D PRNT ; S ^ TMP ( $ J , "A" _ $ P ( ^ PSNDF ( 50.67 , SIE , 0 ) , "^" , 2 ) _ "^" _SIE ) = ""
Q
PRT D : ( $ Y + 5 ) > IOSL & ( ' $ G ( QUIT ) ) HANG Q : $ G ( QUIT ) S DA = SIE , DIC = "^PSNDF(50.67," W ! D EN ^ DIQ
Q
;
LISTNDC1 ; LOOK UP PARTIAL NDC
;
F K ^ TMP ( $ J ) S QUIT = 0 , DIR ( 0 ) = "F^1:12" , DIR ( "A" ) = "Select NDC " D ^ DIR Q : $ D ( DIRUT ) S PSN1 = Y , PSN = Y D
. I $ D ( ^ PSNDF ( 50.67 , "NDC" , PSN1 ) ) S DA = 0 F S DA = $ O ( ^ PSNDF ( 50.67 , "NDC" , PSN1 , DA ) ) S : ' DA QUIT = 1 Q : QUIT S DIC = "^PSNDF(50.67," W ! D EN ^ DIQ
. Q : QUIT
. I PSN1 ? . "0" . E S PSN1 = PSN1_ "/"
. I PSN1 ? . N , PSN1 = + PSN1 S PSN1 = $ $ LJ ^ XLFSTR ( PSN1 , 12 , 0 ) -1
. S ZCT = 0 F Q : QUIT S PSN1 = $ O ( ^ PSNDF ( 50.67 , "NDC" , PSN1 ) ) , DA = 0 Q : $ E ( PSN1 , 1 , $ L ( PSN ) ) ' = PSN F Q : QUIT S DA = $ O ( ^ PSNDF ( 50.67 , "NDC" , PSN1 , DA ) ) Q : ' DA S ZCT = ZCT + 1 , ^ TMP ( $ J , ZCT ) = DA W ! , $ J ( ZCT , 5 ) , " " , PSN1 D
. . S MORE = $ E ( $ O ( ^ PSNDF ( 50.67 , "NDC" , PSN1 ) ) , 1 , $ L ( PSN ) ) = PSN ! $ O ( ^ ( PSN1 , DA ) ) I ZCT #5 & MORE Q
. . S DIR ( 0 ) = "NOA^1:" _ZCT , DIR ( "A" ) = "Choose 1 - " _ZCT _ " or ^ to quit " S : MORE DIR ( "A" ) = DIR ( "A" ) _ "or return to see more "
. . D ^ DIR I $ D ( DUOUT ) ! $ D ( DTOUT ) S QUIT = 1 Q
. . I Y = "" Q
. . S DA = ^ TMP ( $ J , Y ) , QUIT = 1 , DIC = "^PSNDF(50.67," W ! ! D EN ^ DIQ Q
G END
ENTER1 K QQQ S Z0 = ^ PSNDF ( 50.68 , ZA , 0 ) , Z1 = ^ PSNDF ( 50.68 , ZA , 1 ) , Z3 = ^ PSNDF ( 50.68 , ZA , 3 ) , Z7 = $ G ( ^ PSNDF ( 50.68 , ZA , 7 ) ) , Z5 = $ G ( ^ PSNDF ( 50.68 , ZA , 5 ) ) , Z6 = $ G ( ^ PSNDF ( 50.68 , ZA , 6 , 1 , 0 ) ) , QQQ = $ P ( Z1 , "^" , 5 ) D GCN D
. W ! , "VA Product Name: " , $ P ( Z0 , "^" ) , ! , "VA Generic Name: " , $ P ( ^ PSNDF ( 50.6 , + $ P ( Z0 , "^" , 2 ) , 0 ) , "^" ) , ! , "Dose Form: " , $ P ( ^ PS ( 50.606 , + $ P ( Z0 , "^" , 3 ) , 0 ) , "^" ) , " Strength: " , $ P ( Z0 , "^" , 4 ) , " Units: " , $ P ( $ G ( ^ PS ( 50.607 , + $ P ( Z0 , "^" , 5 ) , 0 ) ) , "^" )
. W ! , "National Formulary Name: " , $ P ( Z0 , "^" , 6 ) , ! , "VA Print Name: " , $ P ( Z1 , "^" ) , ! , "VA Product Identifier: " , $ P ( Z1 , "^" , 2 ) , " Transmit to CMOP: " , $ S ( $ P ( Z1 , "^" , 3 ) : "Yes" , 1 : "No" )
. W " VA Dispense Unit: " , $ P ( $ G ( ^ PSNDF ( 50.64 , + $ P ( Z1 , "^" , 4 ) , 0 ) ) , "^" )
. W ! , "PMIS: " , PMIS , ! , "Active Ingredients: " S K = 0 F S K = $ O ( ^ PSNDF ( 50.68 , ZA , 2 , K ) ) Q : ' K ! ( $ G ( QUIT ) ) S X = ^ ( K , 0 ) , ING = ^ PS ( 50.416 , K , 0 ) S : $ P ( ING , "^" , 2 ) ING = ^ PS ( 50.416 , $ P ( ING , "^" , 2 ) , 0 ) D
. . D : ( $ Y + 5 ) > IOSL & ( ' $ G ( QUIT ) ) HANG Q : $ G ( QUIT ) W ? 23 , $ P ( ING , "^" ) , " Strength: " , $ P ( X , "^" , 2 ) , " Units :" , $ P ( $ G ( ^ PS ( 50.607 , + $ P ( X , "^" , 3 ) , 0 ) ) , "^" ) , !
. Q : $ G ( QUIT ) W ! , "Primary VA Drug Class: " , $ P ( $ G ( ^ PS ( 50.605 , + Z3 , 0 ) , "Unknown" ) , "^" ) , ! , "Secondary VA Drug Class: " S K = 0 F S K = $ O ( ^ PSNDF ( 50.68 , ZA , 4 , K ) ) Q : ' K W ? 26 , $ P ( $ G ( ^ PS ( 50.605 , + K , 0 ) , "Unknown" ) , "^" ) , !
. W ! , "CS Federal Schedule: " _ $ S ( $ P ( Z7 , "^" ) ] "" : $ P ( Z7 , "^" ) , 1 : "" )
. W ! , "National Formulary Indicator: " W : $ P ( Z5 , "^" ) = 1 "Yes" W : $ P ( Z5 , "^" ) = 0 "No"
. W ! , "National Formulary Restriction: " , ! , $ P ( Z6 , "^" )
. I $ G ( ^ PSNDF ( 50.68 , DA , 8 ) ) W ! , "Exclude Drg-Drg Interaction Ck: Yes (No check for Drug-Drug Interactions)"
Q
CMOP K DIC S DIC = "^PSNDF(50.68," , DIC ( 0 ) = "QEAZ" , D = "C" , DIC ( "A" ) = "CMOP ID: " D MIX ^ DIC1 Q : Y < 0 S IEN = + Y D ENTER F SIE = 0 : 0 S SIE = $ O ( ^ PSNDF ( 50.68 , "ANDC" , IEN , SIE ) ) Q : ' SIE D PRNT
Q
HANG K DIR S DIR ( 0 ) = "E" , DIR ( "A" ) = "Press return to continue or '^' to exit" D ^ DIR W @ IOF S $ X = 0 S : Y ' = 1 QUIT = 1
Q
PRNT D : ( $ Y + 5 ) > IOSL & ( ' $ G ( QUIT ) ) HANG Q : $ G ( QUIT )
S NDX = ^ PSNDF ( 50.67 , SIE , 0 )
W ! ! , "NDC: " , $ P ( NDX , "^" , 2 ) , " UPN: " , $ P ( NDX , "^" , 3 ) , ! , "VA Product Name: " , $ P ( ^ PSNDF ( 50.68 , $ P ( NDX , "^" , 6 ) , 0 ) , "^" ) , ! , "Manufacturer: " , $ P ( $ G ( ^ PS ( 55.95 , + $ P ( NDX , "^" , 4 ) , 0 ) ) , "^" ) , " Trade Name: " , $ P ( NDX , "^" , 5 ) , ! , "Route: "
S SIE1 = 0 F S SIE1 = $ O ( ^ PSNDF ( 50.67 , SIE , 1 , SIE1 ) ) Q : ' SIE1 W $ P ( ^ ( SIE1 , 0 ) , "^" )
W ! , "Package Size: " , $ P ( ^ PS ( 50.609 , $ P ( NDX , "^" , 8 ) , 0 ) , "^" ) , " Package Type: " , $ P ( ^ PS ( 50.608 , $ P ( NDX , "^" , 9 ) , 0 ) , "^" )
Q
PAD S ANS = Y F VV = 1 : 1 : 3 S VV1 = $ S ( VV = 1 : 6 , VV = 2 : 4 , VV = 3 : 2 ) D PAD1
S ANS = $ P ( ANS , "-" , 1 ) _ $ P ( ANS , "-" , 2 ) _ $ P ( ANS , "-" , 3 ) K VV , VV1
S ANS = $ TR ( ANS , "-" ) , X = ANS
Q
PAD1 I $ L ( $ P ( ANS , "-" , VV ) ) < VV1 S $ P ( ANS , "-" , VV ) = $ E ( "0000000" , 1 , VV1 - $ L ( $ P ( ANS , "-" , VV ) ) ) _ $ P ( ANS , "-" , VV )
Q
DT ( Y ) ; Inactivation Date display
X : Y ^ DD ( "DD" ) Q $ S ( Y ] "" : IORVON_ " ***INACTIVE: " _Y _ " ***" _IORVOFF , 1 : "" )
Q
GCN I QQQ ' ] "" S PMIS = "None"
I QQQ ] "" , ' $ D ( ^ PS ( 50.623 , "B" , QQQ ) ) S PMIS = "None"
I QQQ ] "" , $ D ( ^ PS ( 50.623 , "B" , QQQ ) ) S MAP = $ O ( ^ PS ( 50.623 , "B" , QQQ , 0 ) ) , ENG = $ P ( ^ PS ( 50.623 , MAP , 0 ) , "^" , 2 ) , PMIS = $ P ( ^ PS ( 50.621 , + ENG , 0 ) , "^" )
Q
I QQQ ] "" , $ D ( ^ PS ( 50.623 , "B" , QQQ ) ) S MAP = $ O ( ^ PS ( 50.623 , "B" , QQQ , 0 ) ) , ENG = $ P ( ^ PS ( 50.623 , MAP , 0 ) , "^" , 2 ) , PMIS = $ P ( ^ PS ( 50.621 , + ENG , 0 ) , "^" )
Q