PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21**; 10/24/97
;References to ^PSDRUG( are covered by IA #2095
;References to ^DIC(51.5 are covered by IA #1931
;This routine allows the user to edit invoices with errors or missing
;data.
;
MANYNDCS ;List drug synonym data & ask user which on to use
K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSANDC=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~")
F S PSAIEN50=$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D
.F S PSASYN=$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D
..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
..;DAVE B (PSA*3*3)
..Q:$D(^PSDRUG(PSAIEN50,"I"))
..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
G:PSAFND SAME G:PSACNT DIFF
Q
;
SAME ;If more than one drug with same VSN, assign to correct drug.
W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",!
S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D
.S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0) S PSAMENU=PSAMENU+1
.Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
.D LIST Q:PSAOUT
D CHOOSE Q:PSAOUT!(Y="")
I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
I PSAPICK<PSAMENU D
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),$P(^(PSALINE),"^",5)=$P($P(^(PSALINE),"^",5),"~"),PSANEXT=1,PSADATA=^(PSALINE)
.I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D
..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE)
..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
..D HDR^PSAPROC6,EDIT1^PSAUTL1
G KILL
;
DIFF ;If more than one drug with different VSN, assign to correct drug.
W !,"There is more than one item in the DRUG file with the same NDC.",!
S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D
.S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1
.Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
.D LIST Q:PSAOUT
D CHOOSE Q:PSAOUT!(Y="")
I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
I PSAPICK<PSAMENU D
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE)
.I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D
..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE)
..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
..D HDR^PSAPROC6,EDIT1^PSAUTL1
KILL K PSASAME,PSAFND
Q
;
LIST Q:PSANODE=""!($P($G(^PSDRUG(PSAIEN50,0)),"^")="")
W !?1,PSAMENU_".",?4,$P($G(^PSDRUG(PSAIEN50,0)),"^") I $D(^PSDRUG(PSAIEN50,"I")) W ?60,"(INACTIVE)"
;NOIS CTX-1200-71091 (PSA*3*21 Dave B)
I $P(PSANODE,"^",2)'="" W !,?4,"NDC : "_$P(PSANODE,"^",2)
I +$P(PSANODE,"^",5),$P($G(^DIC(51.5,+$P(PSANODE,"^",5),0)),"^")'="" W !?4,"Order Unit: "_$P(^DIC(51.5,+$P(PSANODE,"^",5),0),"^"),?45,"Price Per Order Unit : $"_$S(+$P(PSANODE,"^",6):$P(PSANODE,"^",6),1:"(Blank)")
E I +$P(PSANODE,"^",6) W !?4,"Price Per Order Unit: $"_$P(PSANODE,"^",6)
I $P(PSANODE,"^",9)'="" W !?4,"Vendor: "_$P(PSANODE,"^",9),?45,"VSN: "_$S($P(PSANODE,"^",4)'="":$P(PSANODE,"^",4),1:"(Blank)")
E I $P(PSANODE,"^",4)'="" W !?4,"VSN: "_$S($P(PSANODE,"^",4)'="":$P(PSANODE,"^",4),1:"(Blank)")
Q
;
CHOOSE S PSAMENU=PSAMENU+1
W !?1,PSAMENU,".",?4,"Select another drug."
W ! S DIR(0)="N^1:"_PSAMENU,DIR("A")="Select the invoiced drug",DIR("?")="Select the drug from the list for which you were invoiced.",DIR("??")="^D NDCHELP^PSAPROC4"
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
S PSAPICK=+Y
Q
;
MANYVSNS ;List drug synonym data & ask user which on to use
K PSADIFF,PSASAME S (PSACNT,PSAFND,PSAIEN50)=0,PSAVSN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~")
F S PSAIEN50=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50)) Q:'PSAIEN50 S PSASYN=0 D
.F S PSASYN=$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN)) Q:'PSASYN D
..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
..;DAVE B (PSA*3*3)
..Q:$D(^PSDRUG(PSAIEN50,"I"))
..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC S PSAFND=PSAFND+1,PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC S PSACNT=PSACNT+1,PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
G:PSAFND SAMEV G:PSACNT DIFFV
Q
;
SAMEV ;If more than one drug with same NDC, assign to correct drug.
W !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",!
S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSASAME(PSACNT)) Q:'PSACNT D
.S PSAIEN50=$P(PSASAME(PSACNT),"^"),PSASYN=$P(PSASAME(PSACNT),"^",2),PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0),PSAMENU=PSAMENU+1
.Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
.D LIST Q:PSAOUT
D CHOOSE Q:PSAOUT!(Y="")
I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
I PSAPICK<PSAMENU D
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSASAME(PSAPICK),"^",2),PSANEXT=1,PSADATA=^(PSALINE)
.I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSASAME(PSAPICK),"^") D
..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSASAME(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSANEXT=1,PSADATA=^(PSALINE)
..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
..D HDR^PSAPROC6,EDIT1^PSAUTL1
G KILL
;
DIFFV ;If more than one drug with different VSN, assign to correct drug.
W !,"There is more than one item in the DRUG file with the same VSN.",!
S (PSACNT,PSAMENU)=0 F S PSACNT=$O(PSADIFF(PSACNT)) Q:'PSACNT D
.S PSAIEN50=$P(PSADIFF(PSACNT),"^"),PSASYN=$P(PSADIFF(PSACNT),"^",2),PSANODE=$G(^PSDRUG(PSAIEN50,1,PSASYN,0)),PSAMENU=PSAMENU+1
.Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
.D LIST Q:PSAOUT
D CHOOSE Q:PSAOUT!(Y="")
I PSAPICK=PSAMENU D ASKDRUG^PSANDF G KILL
I PSAPICK<PSAMENU D
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^(PSALINE),"^",7)=$P(PSADIFF(PSAPICK),"^",2),PSANEXT=1
.I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$P(PSADIFF(PSAPICK),"^") D
..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$P(PSADIFF(PSAPICK),"^"),$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE)
..S PSANDC=$P($G(^PSDRUG(+$P(PSADIFF(PSAPICK),"^"),1,+$P(PSADIFF(PSAPICK),"^",2),0)),"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
..I $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP" S $P(^("IN"),"^",13)="",PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
..D HDR^PSAPROC6,EDIT1^PSAUTL1
G KILL
;
NDCHELP ;Extended help for selecting invoiced drug
W !?5,"Enter the number to the left of the invoiced drug. If you select a drug",!?5,"from the list, the invoiced drug will be matched to that drug. If you"
W !?5,"choose to select another drug, you can select the invoiced drug from the",!?5,"DRUG file or flag this item as a supply item."
Q
PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21**; 10/24/97
+2 ;References to ^PSDRUG( are covered by IA #2095
+3 ;References to ^DIC(51.5 are covered by IA #1931
+4 ;This routine allows the user to edit invoices with errors or missing
+5 ;data.
+6 ;
MANYNDCS ;List drug synonym data & ask user which on to use
+1 KILL PSADIFF,PSASAME
SET (PSACNT,PSAFND,PSAIEN50)=0
SET PSANDC=$PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~")
+2 FOR
SET PSAIEN50=$ORDER(^PSDRUG("C",PSANDC,PSAIEN50))
IF 'PSAIEN50
QUIT
SET PSASYN=0
Begin DoDot:1
+3 FOR
SET PSASYN=$ORDER(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN))
IF 'PSASYN
QUIT
Begin DoDot:2
+4 IF '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 ;DAVE B (PSA*3*3)
+6 IF $DATA(^PSDRUG(PSAIEN50,"I"))
QUIT
+7 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN
SET PSAFND=PSAFND+1
SET PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
+8 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN
SET PSACNT=PSACNT+1
SET PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
End DoDot:2
End DoDot:1
+9 IF PSAFND
GOTO SAME
IF PSACNT
GOTO DIFF
+10 QUIT
+11 ;
SAME ;If more than one drug with same VSN, assign to correct drug.
+1 WRITE !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",!
+2 SET (PSACNT,PSAMENU)=0
FOR
SET PSACNT=$ORDER(PSASAME(PSACNT))
IF 'PSACNT
QUIT
Begin DoDot:1
+3 SET PSAIEN50=$PIECE(PSASAME(PSACNT),"^")
SET PSASYN=$PIECE(PSASAME(PSACNT),"^",2)
SET PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0)
SET PSAMENU=PSAMENU+1
+4 IF '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 DO LIST
IF PSAOUT
QUIT
End DoDot:1
+6 DO CHOOSE
IF PSAOUT!(Y="")
QUIT
+7 IF PSAPICK=PSAMENU
DO ASKDRUG^PSANDF
GOTO KILL
+8 IF PSAPICK<PSAMENU
Begin DoDot:1
+9 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
SET $PIECE(^(PSALINE),"^",7)=$PIECE(PSASAME(PSAPICK),"^",2)
SET $PIECE(^(PSALINE),"^",5)=$PIECE($PIECE(^(PSALINE),"^",5),"~")
SET PSANEXT=1
SET PSADATA=^(PSALINE)
+10 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$PIECE(PSASAME(PSAPICK),"^")
Begin DoDot:2
+11 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$PIECE(PSASAME(PSAPICK),"^")
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
SET PSANEXT=1
SET PSADATA=^(PSALINE)
+12 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
SET $PIECE(^("IN"),"^",13)=""
SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+13 DO HDR^PSAPROC6
DO EDIT1^PSAUTL1
End DoDot:2
End DoDot:1
+14 GOTO KILL
+15 ;
DIFF ;If more than one drug with different VSN, assign to correct drug.
+1 WRITE !,"There is more than one item in the DRUG file with the same NDC.",!
+2 SET (PSACNT,PSAMENU)=0
FOR
SET PSACNT=$ORDER(PSADIFF(PSACNT))
IF 'PSACNT
QUIT
Begin DoDot:1
+3 SET PSAIEN50=$PIECE(PSADIFF(PSACNT),"^")
SET PSASYN=$PIECE(PSADIFF(PSACNT),"^",2)
SET PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0)
SET PSAMENU=PSAMENU+1
+4 IF '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 DO LIST
IF PSAOUT
QUIT
End DoDot:1
+6 DO CHOOSE
IF PSAOUT!(Y="")
QUIT
+7 IF PSAPICK=PSAMENU
DO ASKDRUG^PSANDF
GOTO KILL
+8 IF PSAPICK<PSAMENU
Begin DoDot:1
+9 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
SET $PIECE(^(PSALINE),"^",7)=$PIECE(PSADIFF(PSAPICK),"^",2)
SET PSANEXT=1
SET PSADATA=^(PSALINE)
+10 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$PIECE(PSADIFF(PSAPICK),"^")
Begin DoDot:2
+11 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$PIECE(PSADIFF(PSAPICK),"^")
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
SET PSANEXT=1
SET PSADATA=^(PSALINE)
+12 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
SET $PIECE(^("IN"),"^",13)=""
SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+13 DO HDR^PSAPROC6
DO EDIT1^PSAUTL1
End DoDot:2
End DoDot:1
KILL KILL PSASAME,PSAFND
+1 QUIT
+2 ;
LIST IF PSANODE=""!($PIECE($GET(^PSDRUG(PSAIEN50,0)),"^")="")
QUIT
+1 WRITE !?1,PSAMENU_".",?4,$PIECE($GET(^PSDRUG(PSAIEN50,0)),"^")
IF $DATA(^PSDRUG(PSAIEN50,"I"))
WRITE ?60,"(INACTIVE)"
+2 ;NOIS CTX-1200-71091 (PSA*3*21 Dave B)
+3 IF $PIECE(PSANODE,"^",2)'=""
WRITE !,?4,"NDC : "_$PIECE(PSANODE,"^",2)
+4 IF +$PIECE(PSANODE,"^",5)
IF $PIECE($GET(^DIC(51.5,+$PIECE(PSANODE,"^",5),0)),"^")'=""
WRITE !?4,"Order Unit: "_$PIECE(^DIC(51.5,+$PIECE(PSANODE,"^",5),0),"^"),?45,"Price Per Order Unit : $"_$SELECT(+$PIECE(PSANODE,"^",6):$PIECE(PSANODE,"^",6),1:"(Blank)")
+5 IF '$TEST
IF +$PIECE(PSANODE,"^",6)
WRITE !?4,"Price Per Order Unit: $"_$PIECE(PSANODE,"^",6)
+6 IF $PIECE(PSANODE,"^",9)'=""
WRITE !?4,"Vendor: "_$PIECE(PSANODE,"^",9),?45,"VSN: "_$SELECT($PIECE(PSANODE,"^",4)'="":$PIECE(PSANODE,"^",4),1:"(Blank)")
+7 IF '$TEST
IF $PIECE(PSANODE,"^",4)'=""
WRITE !?4,"VSN: "_$SELECT($PIECE(PSANODE,"^",4)'="":$PIECE(PSANODE,"^",4),1:"(Blank)")
+8 QUIT
+9 ;
CHOOSE SET PSAMENU=PSAMENU+1
+1 WRITE !?1,PSAMENU,".",?4,"Select another drug."
+2 WRITE !
SET DIR(0)="N^1:"_PSAMENU
SET DIR("A")="Select the invoiced drug"
SET DIR("?")="Select the drug from the list for which you were invoiced."
SET DIR("??")="^D NDCHELP^PSAPROC4"
+3 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 SET PSAPICK=+Y
+5 QUIT
+6 ;
MANYVSNS ;List drug synonym data & ask user which on to use
+1 KILL PSADIFF,PSASAME
SET (PSACNT,PSAFND,PSAIEN50)=0
SET PSAVSN=$PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5),"~")
+2 FOR
SET PSAIEN50=$ORDER(^PSDRUG("AVSN",PSAVSN,PSAIEN50))
IF 'PSAIEN50
QUIT
SET PSASYN=0
Begin DoDot:1
+3 FOR
SET PSASYN=$ORDER(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN))
IF 'PSASYN
QUIT
Begin DoDot:2
+4 IF '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 ;DAVE B (PSA*3*3)
+6 IF $DATA(^PSDRUG(PSAIEN50,"I"))
QUIT
+7 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC
SET PSAFND=PSAFND+1
SET PSASAME(PSAFND)=PSAIEN50_"^"_PSASYN
+8 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC
SET PSACNT=PSACNT+1
SET PSADIFF(PSACNT)=PSAIEN50_"^"_PSASYN
End DoDot:2
End DoDot:1
+9 IF PSAFND
GOTO SAMEV
IF PSACNT
GOTO DIFFV
+10 QUIT
+11 ;
SAMEV ;If more than one drug with same NDC, assign to correct drug.
+1 WRITE !,"There is more than one item in the DRUG file",!,"with the same NDC and Vendor Stock Number.",!
+2 SET (PSACNT,PSAMENU)=0
FOR
SET PSACNT=$ORDER(PSASAME(PSACNT))
IF 'PSACNT
QUIT
Begin DoDot:1
+3 SET PSAIEN50=$PIECE(PSASAME(PSACNT),"^")
SET PSASYN=$PIECE(PSASAME(PSACNT),"^",2)
SET PSANODE=^PSDRUG(PSAIEN50,1,PSASYN,0)
SET PSAMENU=PSAMENU+1
+4 IF '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 DO LIST
IF PSAOUT
QUIT
End DoDot:1
+6 DO CHOOSE
IF PSAOUT!(Y="")
QUIT
+7 IF PSAPICK=PSAMENU
DO ASKDRUG^PSANDF
GOTO KILL
+8 IF PSAPICK<PSAMENU
Begin DoDot:1
+9 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
SET $PIECE(^(PSALINE),"^",7)=$PIECE(PSASAME(PSAPICK),"^",2)
SET PSANEXT=1
SET PSADATA=^(PSALINE)
+10 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$PIECE(PSASAME(PSAPICK),"^")
Begin DoDot:2
+11 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$PIECE(PSASAME(PSAPICK),"^")
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
SET PSANEXT=1
SET PSADATA=^(PSALINE)
+12 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
SET $PIECE(^("IN"),"^",13)=""
SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+13 DO HDR^PSAPROC6
DO EDIT1^PSAUTL1
End DoDot:2
End DoDot:1
+14 GOTO KILL
+15 ;
DIFFV ;If more than one drug with different VSN, assign to correct drug.
+1 WRITE !,"There is more than one item in the DRUG file with the same VSN.",!
+2 SET (PSACNT,PSAMENU)=0
FOR
SET PSACNT=$ORDER(PSADIFF(PSACNT))
IF 'PSACNT
QUIT
Begin DoDot:1
+3 SET PSAIEN50=$PIECE(PSADIFF(PSACNT),"^")
SET PSASYN=$PIECE(PSADIFF(PSACNT),"^",2)
SET PSANODE=$GET(^PSDRUG(PSAIEN50,1,PSASYN,0))
SET PSAMENU=PSAMENU+1
+4 IF '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 DO LIST
IF PSAOUT
QUIT
End DoDot:1
+6 DO CHOOSE
IF PSAOUT!(Y="")
QUIT
+7 IF PSAPICK=PSAMENU
DO ASKDRUG^PSANDF
GOTO KILL
+8 IF PSAPICK<PSAMENU
Begin DoDot:1
+9 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
SET $PIECE(^(PSALINE),"^",7)=$PIECE(PSADIFF(PSAPICK),"^",2)
SET PSANEXT=1
+10 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)'=$PIECE(PSADIFF(PSAPICK),"^")
Begin DoDot:2
+11 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=$PIECE(PSADIFF(PSAPICK),"^")
SET $PIECE(^(PSALINE),"^",16)=DUZ
SET $PIECE(^(PSALINE),"^",17)=DT
SET PSADATA=^(PSALINE)
+12 SET PSANDC=$PIECE($GET(^PSDRUG(+$PIECE(PSADIFF(PSAPICK),"^"),1,+$PIECE(PSADIFF(PSAPICK),"^",2),0)),"^")
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
+13 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
SET $PIECE(^("IN"),"^",13)=""
SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
+14 DO HDR^PSAPROC6
DO EDIT1^PSAUTL1
End DoDot:2
End DoDot:1
+15 GOTO KILL
+16 ;
NDCHELP ;Extended help for selecting invoiced drug
+1 WRITE !?5,"Enter the number to the left of the invoiced drug. If you select a drug",!?5,"from the list, the invoiced drug will be matched to that drug. If you"
+2 WRITE !?5,"choose to select another drug, you can select the invoiced drug from the",!?5,"DRUG file or flag this item as a supply item."
+3 QUIT
