PSANDF ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8,11**; 10/24/97
;This routine searches NDF for the NDC. If it is not found, the user
;is asked to select the drug from the DRUG file.
;
I PSANDC="",$P(PSADATA,"^",26)'="" D Q
.I +$P($P(PSADATA,"^",26),"~",2) D
..K PSASUP S PSASUP="S"_$P(PSADATA,"^",26),(PSACNT,PSAIEN50)=0
..F S PSAIEN50=$O(^PSDRUG("C",PSASUP,PSAIEN50)) Q:PSAIEN50="" D
...S PSASSUB=0 F S PSASSUB=$O(^PSDRUG("C",PSASUP,PSAIEN50,PSASSUB)) Q:'PSASSUB S PSACNT=PSACNT+1,PSASUP(PSACNT)=PSAIEN50_"^"_PSASSUB
..I 'PSACNT D Q
...W !,"The vendor sent no NDC or UPC for the item."
...D ASKDRUG S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
..I PSACNT=1 D Q
...S PSAIEN=$P(PSASUP(1),"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSASUP(1),"^",2),$P(^(PSALINE),"^",7)=PSASUB
...S PSANDC=PSASUP,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,PSAVSN=$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",4),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
...S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
..I PSACNT>1 S PSACNT=$O(PSASUP(0)) D:PSACNT MANYUPCS^PSAPROC5
;
LOOKNDF S PSACNT=0,X=$$PSA^PSNAPIS(PSANDC,.PSALIST),PSACNT=X
K ^TMP("PSANDF",$J) S X=0 F S X=$O(PSALIST(X)) Q:X'>0 S ^TMP("PSANDF",$J,X)=PSALIST(X)
;
;DAVEB (PSA*3*11)
I $D(^TMP("PSANDF",$J)) S XX=$O(^TMP("PSANDF",$J,0)),PSAVAPN=$P($G(^PSDRUG(XX,"ND")),"^",2) K XX
I $G(PSACNT)>0 S X=0 F S X=$O(PSALIST(X)) Q:X'>0 I '$D(^PSDRUG(X,"I")) S ^TMP("PSANDF",$J,X)=$P(PSALIST(X),"^")
I '$D(PSAVAPN),$D(PSALIST) S PSAVAPN=$O(PSALIST(0)),PSAVAPN=$S('$D(^PSDRUG(PSAVAPN,"ND")):"Unknown",1:$P($G(^PSDRUG(PSAVAPN,"ND")),"^",2))
K PSALIST,X
NONE I 'PSACNT D Q
.I +$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",2)!($P($P(^(PSALINE),"^",4),"~",3)'="") D ^PSAPROC4
.E D ASKDRUG
I PSACNT=1 S PSAVAPN=$P($G(^PSDRUG($O(^TMP("PSANDF",$J,0)),"ND")),"^",2) D ONE Q
;
MANY ;Display for selection if more than 1 drug is found for the Product Name
W !!,"The NDC has the VA Product Name of "_PSAVAPN_".",!,"The following drugs have the same VA Product Name.",!
S (PSACNT,PSAGET,PSAIEN50)=0 F S PSAIEN50=+$O(^TMP("PSANDF",$J,PSAIEN50)) Q:'PSAIEN50 D Q:PSAGET!(+$G(PSAIEN))
.S PSACNT=PSACNT+1,^TMP("PSACNT",$J,PSACNT)=PSAIEN50
.W !?2,PSACNT_". "_^TMP("PSANDF",$J,PSAIEN50)
.I PSACNT#5=0 D Q:PSAGET!($G(PSAIEN))
..W ! S DIR(0)="N^1:"_PSACNT,DIR("A",1)="Select the received drug or",DIR("A")="enter ""^"" to select the drug from the DRUG file.",DIR("?",1)="Choose the drug you received and assign it to the line item."
..S DIR("?")="To exit the list and select the drug from the DRUG file, enter ""^"".",DIR("??")="^D SELNDF^PSANDF1" D ^DIR K DIR I $G(DUOUT) S PSAGET=1 Q
..I $G(DTOUT) S PSAOUT=1 Q
..I +Y S PSAIEN=^TMP("PSACNT",$J,+Y),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT
I '$G(PSAIEN),'PSAOUT,PSACNT#5'=0 D G:Y="^" ASKDRUG Q:PSAOUT!($G(PSAIEN))
.W ! S DIR(0)="N^1:"_PSACNT,DIR("A",1)="Select the received drug or",DIR("A")="enter ""^"" to select the drug from the DRUG file."
.S DIR("?")="Select the drug you received or enter ""^"" to select the drug from the DRUG file.",DIR("??")="^D SELNDF^PSANDF1" D ^DIR K DIR Q:Y="^"
.I $G(DTOUT) S PSAOUT=1 Q
.S PSAIEN=^TMP("PSACNT",$J,+Y),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE) D EDITDISP^PSAUTL1
K ^TMP("PSACNT",$J,PSACNT),^TMP("PSANDF",$J)
Q:+$G(PSAIEN)!(PSAOUT)
I +$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",2),$P($P(^(PSALINE),"^",4),"~",3)'="" G ^PSAPROC4
;
ASKDRUG ;If the NDC found by searching NDF is not correct OR if the NDC can't
;be found, the user is asked to select the drug.
W !!,"If the item will never be in the DRUG, press the Return key then",!,"answer YES to the ""Is this a supply item?"" prompt. To bypass this",!,"line item, enter ""^"" then press the Return key.",!
S (PSASKIP,PSAPASS)=0,DIC("A")="Select Drug: ",DIC(0)="AEMZQ",DIC="^PSDRUG("
D ^DIC K DIC I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
S PSAREA=""
I +Y=-1 D Q:PSASUPP Q:PSASKIP
.D SUPPLY Q:PSAOUT
.I 'PSASUPP S PSASKIP=1 Q
.S PSAIEN=0,^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")=DUZ_"^"_DT_"^"_PSAREA,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P",PSADATA=^(PSALINE)
S PSAIEN=+Y K ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")
S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=+Y,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE)
D EDITDISP^PSAUTL1
;
CHECK I $G(PSANDC)'="" D Q
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,PSAFND=0
.S PSASUB=0 F S PSASUB=+$O(^PSDRUG(PSAIEN,1,PSASUB)) Q:'PSASUB I $P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^")=PSANDC S PSAFND=1 Q
.I PSAFND S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)=PSASUB
;
S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)="0~1"
I $P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~")="",$P($P(^(PSALINE),"^",26),"~")="" D
.W !,"The vendor did not send a NDC or UPC for the drug. Enter the",!,"NDC if it is available. Enter the UPC if you do not know the NDC.",!
.S DIR(0)="SA^N:NDC;U:UPC",DIR("A")="Will you enter the NDC or UPC? ",DIR("B")="N",DIR("??")="^D NDCUPC^PSANDF1" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
.I Y="N" D GETNDC Q:PSAOUT S PSANDC=Y,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
.I Y="U" D GETUPC Q:PSAOUT S PSANDC="S"_Y,PSAUPC=Y,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",26)=PSAUPC
Q
;
ONE ;Display for selection if 1 drug is found for that Product Name.
S PSAIEN50=$O(^TMP("PSANDF",$J,0))
W !!,"The NDC has the VA Product Name of "_PSAVAPN_"."
S DIR("A")="Is "_^TMP("PSANDF",$J,PSAIEN50)_" the drug you received",DIR(0)="Y",DIR("B")="N"
S DIR("?",1)="Enter Yes if the drug is the one you received for this line item.",DIR("?")="Enter No if it is not the drug you received.",DIR("??")="^D NDFDRG^PSANDF1"
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
I +Y S PSAIEN=+PSAIEN50,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT K ^TMP("PSANDF",$J) D EDITDISP^PSAUTL1 Q
D ASKDRUG
Q
;
GETNDC ;Gets NDC for selected drug.
S DIR(0)="F^12:12",DIR("A")="NDC",DIR("?")="Enter the 12-digit National Drug Code. Do not enter dashes",DIR("??")="^D NDC^PSANDF1"
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
I Y'?12N W !,"You must enter exactly twelve numbers." G GETNDC
Q
GETUPC ;Gets UPC for selected drug.
S DIR(0)="F^1:30",DIR("A")="UPC",DIR("?")="Enter the Universal Product Code",DIR("??")="^D UPC^PSANDF1"
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
Q
SUPPLY ;Asks if item is a supply. If so, asks for supply info.
S DIR(0)="Y",DIR("A")="Is this a supply item",DIR("?")="Enter YES if the item is not and will never be in the DRUG file",DIR("??")="^D SUP^PSANDF1" D ^DIR K DIR S PSASUPP=Y Q:$G(DIRUT)
I 'PSASUPP S PSAPASS=1 Q
W ! S DIR(0)="F^3:30",DIR("A",1)="Enter either a description of the item or",DIR("A")="the reason why the item is not in the DRUG file"
S DIR("?",1)="If the item is a supply, enter the name of the supply",DIR("?")="or a reason why this item is not in the DRUG file.",DIR("??")="^D REA^PSANDF1" D ^DIR K DIR S PSAREA=Y I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1
S:PSAREA="" PSAREA="SUPPLY ITEM"
Q:$G(PSAVER)
S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)="",$P(^(PSALINE),"^",16)="",$P(^(PSALINE),"^",17)=""
Q
PSANDF ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8,11**; 10/24/97
+2 ;This routine searches NDF for the NDC. If it is not found, the user
+3 ;is asked to select the drug from the DRUG file.
+4 ;
+5 IF PSANDC=""
IF $PIECE(PSADATA,"^",26)'=""
Begin DoDot:1
+6 IF +$PIECE($PIECE(PSADATA,"^",26),"~",2)
Begin DoDot:2
+7 KILL PSASUP
SET PSASUP="S"_$PIECE(PSADATA,"^",26)
SET (PSACNT,PSAIEN50)=0
+8 FOR
SET PSAIEN50=$ORDER(^PSDRUG("C",PSASUP,PSAIEN50))
IF PSAIEN50=""
QUIT
Begin DoDot:3
+9 SET PSASSUB=0
FOR
SET PSASSUB=$ORDER(^PSDRUG("C",PSASUP,PSAIEN50,PSASSUB))
IF 'PSASSUB
QUIT
SET PSACNT=PSACNT+1
SET PSASUP(PSACNT)=PSAIEN50_"^"_PSASSUB
End DoDot:3
+10 IF 'PSACNT
Begin DoDot:3
+11 WRITE !,"The vendor sent no NDC or UPC for the item."
+12 DO ASKDRUG
SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
End DoDot:3
QUIT
+13 IF PSACNT=1
Begin DoDot:3
+14 SET PSAIEN=$PIECE(PSASUP(1),"^")
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
SET PSASUB=$PIECE(PSASUP(1),"^",2)
SET $PIECE(^(PSALINE),"^",7)=PSASUB
+15 SET PSANDC=PSASUP
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
SET PSAVSN=$PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",4)
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
+16 SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
End DoDot:3
QUIT
+17 IF PSACNT>1
SET PSACNT=$ORDER(PSASUP(0))
IF PSACNT
DO MANYUPCS^PSAPROC5
End DoDot:2
End DoDot:1
QUIT
+18 ;
LOOKNDF SET PSACNT=0
SET X=$$PSA^PSNAPIS(PSANDC,.PSALIST)
SET PSACNT=X
+1 KILL ^TMP("PSANDF",$JOB)
SET X=0
FOR
SET X=$ORDER(PSALIST(X))
IF X'>0
QUIT
SET ^TMP("PSANDF",$JOB,X)=PSALIST(X)
+2 ;
+3 ;DAVEB (PSA*3*11)
+4 IF $DATA(^TMP("PSANDF",$JOB))
SET XX=$ORDER(^TMP("PSANDF",$JOB,0))
SET PSAVAPN=$PIECE($GET(^PSDRUG(XX,"ND")),"^",2)
KILL XX
+5 IF $GET(PSACNT)>0
SET X=0
FOR
SET X=$ORDER(PSALIST(X))
IF X'>0
QUIT
IF '$DATA(^PSDRUG(X,"I"))
SET ^TMP("PSANDF",$JOB,X)=$PIECE(PSALIST(X),"^")
+6 IF '$DATA(PSAVAPN)
IF $DATA(PSALIST)
SET PSAVAPN=$ORDER(PSALIST(0))
SET PSAVAPN=$SELECT('$DATA(^PSDRUG(PSAVAPN,"ND")):"Unknown",1:$PIECE($GET(^PSDRUG(PSAVAPN,"ND")),"^",2))
+7 KILL PSALIST,X
NONE IF 'PSACNT
Begin DoDot:1
+1 IF +$PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",2)!($PIECE($PIECE(^(PSALINE),"^",4),"~",3)'="")
DO ^PSAPROC4
+2 IF '$TEST
DO ASKDRUG
End DoDot:1
QUIT
+3 IF PSACNT=1
SET PSAVAPN=$PIECE($GET(^PSDRUG($ORDER(^TMP("PSANDF",$JOB,0)),"ND")),"^",2)
DO ONE
QUIT
+4 ;
MANY ;Display for selection if more than 1 drug is found for the Product Name
+1 WRITE !!,"The NDC has the VA Product Name of "_PSAVAPN_".",!,"The following drugs have the same VA Product Name.",!
+2 SET (PSACNT,PSAGET,PSAIEN50)=0
FOR
SET PSAIEN50=+$ORDER(^TMP("PSANDF",$JOB,PSAIEN50))
IF 'PSAIEN50
QUIT
Begin DoDot:1
+3 SET PSACNT=PSACNT+1
SET ^TMP("PSACNT",$JOB,PSACNT)=PSAIEN50
+4 WRITE !?2,PSACNT_". "_^TMP("PSANDF",$JOB,PSAIEN50)
+5 IF PSACNT#5=0
Begin DoDot:2
+6 WRITE !
SET DIR(0)="N^1:"_PSACNT
SET DIR("A",1)="Select the received drug or"
SET DIR("A")="enter ""^"" to select the drug from the DRUG file."
SET DIR("?",1)="Choose the drug you received and assign it to the line item."
+7 SET DIR("?")="To exit the list and select the drug from the DRUG file, enter ""^""."
SET DIR("??")="^D SELNDF^PSANDF1"
DO ^DIR
KILL DIR
IF $GET(DUOUT)
SET PSAGET=1
QUIT
+8 IF $GET(DTOUT)
SET PSAOUT=1
QUIT
+9 IF +Y
SET PSAIEN=^TMP("PSACNT",$JOB,+Y)
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
End DoDot:2
IF PSAGET!($GET(PSAIEN))
QUIT
End DoDot:1
IF PSAGET!(+$GET(PSAIEN))
QUIT
+10 IF '$GET(PSAIEN)
IF 'PSAOUT
IF PSACNT#5'=0
Begin DoDot:1
+11 WRITE !
SET DIR(0)="N^1:"_PSACNT
SET DIR("A",1)="Select the received drug or"
SET DIR("A")="enter ""^"" to select the drug from the DRUG file."
+12 SET DIR("?")="Select the drug you received or enter ""^"" to select the drug from the DRUG file."
SET DIR("??")="^D SELNDF^PSANDF1"
DO ^DIR
KILL DIR
IF Y="^"
QUIT
+13 IF $GET(DTOUT)
SET PSAOUT=1
QUIT
+14 SET PSAIEN=^TMP("PSACNT",$JOB,+Y)
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
SET PSADATA=^(PSALINE)
DO EDITDISP^PSAUTL1
End DoDot:1
IF Y="^"
GOTO ASKDRUG
IF PSAOUT!($GET(PSAIEN))
QUIT
+15 KILL ^TMP("PSACNT",$JOB,PSACNT),^TMP("PSANDF",$JOB)
+16 IF +$GET(PSAIEN)!(PSAOUT)
QUIT
+17 IF +$PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",2)
IF $PIECE($PIECE(^(PSALINE),"^",4),"~",3)'=""
GOTO ^PSAPROC4
+18 ;
ASKDRUG ;If the NDC found by searching NDF is not correct OR if the NDC can't
+1 ;be found, the user is asked to select the drug.
+2 WRITE !!,"If the item will never be in the DRUG, press the Return key then",!,"answer YES to the ""Is this a supply item?"" prompt. To bypass this",!,"line item, enter ""^"" then press the Return key.",!
+3 SET (PSASKIP,PSAPASS)=0
SET DIC("A")="Select Drug: "
SET DIC(0)="AEMZQ"
SET DIC="^PSDRUG("
+4 DO ^DIC
KILL DIC
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+5 SET PSAREA=""
+6 IF +Y=-1
Begin DoDot:1
+7 DO SUPPLY
IF PSAOUT
QUIT
+8 IF 'PSASUPP
SET PSASKIP=1
QUIT
+9 SET PSAIEN=0
SET ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")=DUZ_"^"_DT_"^"_PSAREA
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
SET PSADATA=^(PSALINE)
End DoDot:1
IF PSASUPP
QUIT
IF PSASKIP
QUIT
+10 SET PSAIEN=+Y
KILL ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")
+11 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=+Y
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
SET PSADATA=^(PSALINE)
+12 DO EDITDISP^PSAUTL1
+13 ;
CHECK IF $GET(PSANDC)'=""
Begin DoDot:1
+1 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
SET PSAFND=0
+2 SET PSASUB=0
FOR
SET PSASUB=+$ORDER(^PSDRUG(PSAIEN,1,PSASUB))
IF 'PSASUB
QUIT
IF $PIECE($GET(^PSDRUG(PSAIEN,1,PSASUB,0)),"^")=PSANDC
SET PSAFND=1
QUIT
+3 IF PSAFND
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)=PSASUB
End DoDot:1
QUIT
+4 ;
+5 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)="0~1"
+6 IF $PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~")=""
IF $PIECE($PIECE(^(PSALINE),"^",26),"~")=""
Begin DoDot:1
+7 WRITE !,"The vendor did not send a NDC or UPC for the drug. Enter the",!,"NDC if it is available. Enter the UPC if you do not know the NDC.",!
+8 SET DIR(0)="SA^N:NDC;U:UPC"
SET DIR("A")="Will you enter the NDC or UPC? "
SET DIR("B")="N"
SET DIR("??")="^D NDCUPC^PSANDF1"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+9 IF Y="N"
DO GETNDC
IF PSAOUT
QUIT
SET PSANDC=Y
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
+10 IF Y="U"
DO GETUPC
IF PSAOUT
QUIT
SET PSANDC="S"_Y
SET PSAUPC=Y
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
SET $PIECE(^(PSALINE),"^",26)=PSAUPC
End DoDot:1
+11 QUIT
+12 ;
ONE ;Display for selection if 1 drug is found for that Product Name.
+1 SET PSAIEN50=$ORDER(^TMP("PSANDF",$JOB,0))
+2 WRITE !!,"The NDC has the VA Product Name of "_PSAVAPN_"."
+3 SET DIR("A")="Is "_^TMP("PSANDF",$JOB,PSAIEN50)_" the drug you received"
SET DIR(0)="Y"
SET DIR("B")="N"
+4 SET DIR("?",1)="Enter Yes if the drug is the one you received for this line item."
SET DIR("?")="Enter No if it is not the drug you received."
SET DIR("??")="^D NDFDRG^PSANDF1"
+5 DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+6 IF +Y
SET PSAIEN=+PSAIEN50
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
KILL ^TMP("PSANDF",$JOB)
DO EDITDISP^PSAUTL1
QUIT
+7 DO ASKDRUG
+8 QUIT
+9 ;
GETNDC ;Gets NDC for selected drug.
+1 SET DIR(0)="F^12:12"
SET DIR("A")="NDC"
SET DIR("?")="Enter the 12-digit National Drug Code. Do not enter dashes"
SET DIR("??")="^D NDC^PSANDF1"
+2 DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+3 IF Y'?12N
WRITE !,"You must enter exactly twelve numbers."
GOTO GETNDC
+4 QUIT
GETUPC ;Gets UPC for selected drug.
+1 SET DIR(0)="F^1:30"
SET DIR("A")="UPC"
SET DIR("?")="Enter the Universal Product Code"
SET DIR("??")="^D UPC^PSANDF1"
+2 DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+3 QUIT
SUPPLY ;Asks if item is a supply. If so, asks for supply info.
+1 SET DIR(0)="Y"
SET DIR("A")="Is this a supply item"
SET DIR("?")="Enter YES if the item is not and will never be in the DRUG file"
SET DIR("??")="^D SUP^PSANDF1"
DO ^DIR
KILL DIR
SET PSASUPP=Y
IF $GET(DIRUT)
QUIT
+2 IF 'PSASUPP
SET PSAPASS=1
QUIT
+3 WRITE !
SET DIR(0)="F^3:30"
SET DIR("A",1)="Enter either a description of the item or"
SET DIR("A")="the reason why the item is not in the DRUG file"
+4 SET DIR("?",1)="If the item is a supply, enter the name of the supply"
SET DIR("?")="or a reason why this item is not in the DRUG file."
SET DIR("??")="^D REA^PSANDF1"
DO ^DIR
KILL DIR
SET PSAREA=Y
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
+5 IF PSAREA=""
SET PSAREA="SUPPLY ITEM"
+6 IF $GET(PSAVER)
QUIT
+7 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=""
SET $PIECE(^(PSALINE),"^",16)=""
SET $PIECE(^(PSALINE),"^",17)=""
+8 QUIT
