- PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,63**; 10/24/97;Build 10
- ;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)),"^")="")
- ;3*63 RJS
- N PSAPPOU,PSADUOU,PSAPPDU,PSAVEND,PSAOU,PSACPPDU,X,PSANDC,PSADU,PSASYNM,PSAVSN
- S X=PSANODE
- S PSASYNM=$P(X,U,1),PSANDC=$P(X,U,2),PSAVSN=$P(X,U,4),PSAOU=+$P(X,U,5),PSAPPOU=$P(X,U,6)
- S PSADUOU=$P(X,U,7),PSAPPDU=$P(X,U,8),PSAVEND=$P(X,U,9)
- S PSADU=$$GET1^DIQ(50,PSAIEN50,14.5),PSAOU=$P($G(^DIC(51.5,PSAOU,0)),"^")
- S PSACPPDU=$S('PSADUOU:"BLANK",1:(PSAPPOU*1000/PSADUOU\1/1000)) ;recalculate PPDU, file doesn't reset PPDU
- W !?1,PSAMENU_".",?4,$P($G(^PSDRUG(PSAIEN50,0)),"^") I $D(^PSDRUG(PSAIEN50,"I")) W ?60,"(INACTIVE)"
- I PSANDC="",PSAVSN="" W !,?19,"SYN #",PSASYN,": ",PSASYNM,! Q
- W !,?4,"NDC: ",PSANDC,?25,"Order Unit: ",PSAOU,?46,"Price Per Order Unit: $",$FN(PSAPPOU,",",2)
- W !,?4,"VSN: ",PSAVSN,?19,"SYN #",PSASYN,": ",PSASYNM,?42,"Dose Unit Per Order Unit: ",PSADUOU
- W !,?4,"Vendor: ",PSAVEND,?47,"Price Per Dose Unit: ",$FN(PSACPPDU,","),!
- ;3*63 end
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAPROC4 7606 printed Jan 18, 2025@02:51:21 Page 2
- PSAPROC4 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,63**; 10/24/97;Build 10
- +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 ;3*63 RJS
- +2 NEW PSAPPOU,PSADUOU,PSAPPDU,PSAVEND,PSAOU,PSACPPDU,X,PSANDC,PSADU,PSASYNM,PSAVSN
- +3 SET X=PSANODE
- +4 SET PSASYNM=$PIECE(X,U,1)
- SET PSANDC=$PIECE(X,U,2)
- SET PSAVSN=$PIECE(X,U,4)
- SET PSAOU=+$PIECE(X,U,5)
- SET PSAPPOU=$PIECE(X,U,6)
- +5 SET PSADUOU=$PIECE(X,U,7)
- SET PSAPPDU=$PIECE(X,U,8)
- SET PSAVEND=$PIECE(X,U,9)
- +6 SET PSADU=$$GET1^DIQ(50,PSAIEN50,14.5)
- SET PSAOU=$PIECE($GET(^DIC(51.5,PSAOU,0)),"^")
- +7 ;recalculate PPDU, file doesn't reset PPDU
- SET PSACPPDU=$SELECT('PSADUOU:"BLANK",1:(PSAPPOU*1000/PSADUOU\1/1000))
- +8 WRITE !?1,PSAMENU_".",?4,$PIECE($GET(^PSDRUG(PSAIEN50,0)),"^")
- IF $DATA(^PSDRUG(PSAIEN50,"I"))
- WRITE ?60,"(INACTIVE)"
- +9 IF PSANDC=""
- IF PSAVSN=""
- WRITE !,?19,"SYN #",PSASYN,": ",PSASYNM,!
- QUIT
- +10 WRITE !,?4,"NDC: ",PSANDC,?25,"Order Unit: ",PSAOU,?46,"Price Per Order Unit: $",$FNUMBER(PSAPPOU,",",2)
- +11 WRITE !,?4,"VSN: ",PSAVSN,?19,"SYN #",PSASYN,": ",PSASYNM,?42,"Dose Unit Per Order Unit: ",PSADUOU
- +12 WRITE !,?4,"Vendor: ",PSAVEND,?47,"Price Per Dose Unit: ",$FNUMBER(PSACPPDU,","),!
- +13 ;3*63 end
- +14 QUIT
- +15 ;
- 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