- PSABRKU6 ;BIR/DB-Upload and Process Prime Vendor Invoice Data - CONT'D ;10/9/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,48,68**; 10/24/97;Build 7
- ;This routine looks in the DRUG file for each line item on the order.
- ;It looks for the NDC then VSN. If it is not found, no data is stored.
- ;
- ;References to ^DIC(51.5 are covered by IA #1931
- ;References to ^PSDRUG( are covered by IA #2095
- S PSAGUI1=0 ;Counter for Order Unit conversions
- S PSAGUI5=0 ;matched NDC counter
- S PSAGUI6=0 ;matched VSN counter
- S PSAGUI7=0 ;matched Supply Item counter
- S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
- .I '$D(^XTMP("PSAPV",PSACTRL,"IN"))!($P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",8)="P") Q
- .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2),PSACS=0
- .S PSALINE=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
- ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
- ..S PSAOK=1,PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE),PSANDC=$P(PSADATA,"^",4),PSAVSN=$P(PSADATA,"^",5)
- ..DO GETDRUG ;W "."
- ..S:PSAOK $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="OK"
- ..D:PSAOK OUAUTO^PSAUP8 ;*48 ORDER UNIT AUTO ADJUST
- .S (PSACNT,PSALLCS,PSALLOK,PSASUP)=0
- .S:PSACS $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",9)="CS"
- .S PSALINE=0 F S PSALINE=+$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
- ..S PSACNT=PSACNT+1
- ..S:$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS" PSALLCS=PSALLCS+1
- ..S:$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="OK" PSALLOK=PSALLOK+1
- ..S:'+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) PSASUP=PSASUP+1
- .I PSACNT=PSASUP S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
- .I PSACNT=PSALLCS S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)="ALL CS"
- .I PSACNT=PSALLOK S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="OK"
- Q
- ;
- GETDRUG ;Looks for NDC then VSNs in DRUG file.
- I $D(PSANDC) S PSANDC=$P(PSANDC,"~")
- I $D(PSAVSN) S PSAVSN=$P(PSAVSN,"~")
- G:PSANDC=0 GETVSN
- I PSANDC'="" S PSAIEN=+$O(^PSDRUG("C",PSANDC,0)) I PSAIEN S PSASUB=+$O(^PSDRUG("C",PSANDC,PSAIEN,0)) G FOUND
- ;
- GETVSN ;Looks for Vendor Stock Number then NDC.
- I PSAVSN'="" S PSAIEN=+$O(^PSDRUG("AVSN",PSAVSN,0)) I PSAIEN S PSASUB=+$O(^PSDRUG("AVSN",PSAVSN,PSAIEN,0)) G FOUND
- I $G(PSAVSN)'="" S PSAMTCH=0,PSASUPPL=0 D
- .F S PSAMTCH=$O(^XTMP("PSA SUPPLY",PSAMTCH)) Q:PSAMTCH'>0 S DATA=^XTMP("PSA SUPPLY",PSAMTCH,0) I $P(DATA,"^",2)=PSAVSN D
- ..;Found match on supply item
- ..S ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")="UPLOAD GUI"_"^"_DT_"^"_$P(DATA,"^",1)
- ..S PSAGUI7=$G(PSAGUI7)+1,PSASUPPL=1
- I $G(PSASUPPL)>0 G VSN
- ;
- I (PSANDC=""&PSAVSN=""),$P(PSADATA,"^",26)'="" D ^PSAUP6
- ;
- S:'+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) PSAOK=0
- G UOM
- ;
- FOUND ;Store line item data if ordered item was found in DRUG file.
- I $P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" S PSACS=1,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS"
- S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,$P(^(PSALINE),"^",7)=PSASUB
- ;
- NDC ;If >1 NDC in DRUG file, store how many.
- ;^XTMP $P4=NDC ~ # of nodes with same VSN (if >1 NDC) ~ VSN if different
- ; than one on SYNONYM multiple (if 1 NDC)
- I PSANDC'="",$O(^PSDRUG("C",PSANDC,0)) D
- .S (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
- .;
- .F S PSAIEN50=+$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 I '$D(^PSDRUG(PSAIEN50,"I")) S PSASYN=0 F S PSASYN=+$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D
- ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
- ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSAFND1=PSAIEN50_"^"_PSASYN Q
- ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSACNT1=PSAIEN50_"^"_PSASYN
- .;
- .;If NDC & VSN match, set ^XTMP
- .I PSAFND=1 S PSAIEN=$P(PSAFND1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSAFND1,"^",2),$P(^(PSALINE),"^",7)=PSASUB,$P(^(PSALINE),"^",4)=PSANDC Q
- .;
- .;If >1 with same NDC & VSN, set # with same NDC & VSN in ^XTMP & flag
- .I PSAFND>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~"_PSAFND,PSAOK=0 Q
- .;
- .;If 1 NDC and ...
- .I PSACNT=1 S PSAIEN=$P(PSACNT1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSACNT1,"^",2),$P(^(PSALINE),"^",7)=PSASUB D Q
- ..;VSN is null, accept as found & set ^XTMP
- ..I $P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4)="" S PSAIEN=$P(PSACNT1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSACNT1,"^",2),$P(^(PSALINE),"^",7)=PSASUB,$P(^(PSALINE),"^",4)=PSANDC Q
- ..;Different VSN, set VSN in NDC piece in ^XTMP
- ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~~"_$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4),PSAOK=0
- .;
- .;If >1 NDC with different VSN, set flag in NDC piece of ^XTMP
- .I PSACNT>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~"_PSACNT,PSAOK=0
- ;
- VSN ;If there >1 VSN with same VSN, store how many.
- ;^XTMP $P5=VSN ~ # of nodes with same UOM (if >1 VSN) ~ NDC if different
- ; than one on SYNONYM multiple (if 1 VSN)
- I PSAVSN'="",$O(^PSDRUG("AVSN",PSAVSN,0)) D
- .S (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
- .;
- .;DAVE B (PSA*3*2)
- .F S PSAIEN50=+$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50)) Q:'PSAIEN50 I '$D(^PSDRUG(PSAIEN50,"I")) S PSASYN=0 F S PSASYN=+$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN)) Q:'PSASYN D
- ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
- ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC S PSAFND=PSAFND+1,PSAFND1=PSAIEN50_"^"_PSASYN Q
- ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC S PSACNT=PSACNT+1,PSACNT1=PSAIEN50_"^"_PSASYN
- .;
- .;If VSN & NDC match, set ^XTMP
- .I PSAFND=1 D Q
- ..I '+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) D
- ...S PSAIEN=$P(PSAFND1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSAFND1,"^",2),$P(^(PSALINE),"^",7)=PSASUB
- ...S:$P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS",PSACS=1
- ...S:$P($G(^PSDRUG(PSAIEN,2)),"^",3)'["N" $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="",PSACS=0
- ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=+$G(PSAVSN) ;*48
- .;
- .;If >1 with same VSN & NDC, set # with same NDC & VSN in ^XTMP & flag
- .I PSAFND>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~"_PSAFND,PSAOK=0 Q
- .;
- .;If 1 VSN and ...
- .I PSACNT=1 D Q
- ..I '+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) S PSAIEN=$P(PSACNT1,"^"),$P(^(PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSACNT1,"^",2),$P(^(PSALINE),"^",7)=PSASUB
- ..;NDC is null, accept as found & set ^XTMP
- ..;I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)="" S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^") Q
- ..I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)="" S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN D NDCCHK Q
- ..;Different VSN, set VSN in NDC piece in ^XTMP
- ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~~"_$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^"),PSAOK=0
- .;
- .;If >1 VSN with different NDC, set flag in NDC piece of ^XTMP
- .I PSACNT>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~"_PSACNT,PSAOK=0
- ;
- UOM ;Locates X12 Unit of Measure Code in ORDER UNIT file.
- ;^XTMP $P2=Alpha OU ~ 51.5 IEN
- K PSAUOM,PSAGUI I $P(PSADATA,"^",2)="" S PSAOK=0 G QTY
- ;
- S PSAUOM=$P($P(PSADATA,"^",2),"~") I $G(PSAUOM)'="",'$D(^DIC(51.5,"B",PSAUOM)),$D(^PSD(58.812,1,"OU","C",PSALINE)) D
- .S XIEN=$O(^PSD(58.812,1,"OU","C",PSALINE,0)) I $P($G(^PSD(58.812,1,"OU",XIEN,0)),"^",1)=PSAUOM S PSAUOMN=$P(^PSD(58.812,1,"OU",XIEN,0),"^",2),PSAUOM=$P($G(^DIC(51.5,PSAUOMN,0)),"^",1),PSAGUI1=$G(PSAGUI1)+1,PSAGUI=1
- I $G(PSAGUI)=1 D
- .;found unit of measure match in GUI file
- .S PSAUOMN=$O(^DIC(51.5,"B",PSAUOM,0)),PSAGUI=1
- .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOM_"~"_PSAUOMN
- .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",12)=PSAUOM
- .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",13)=.5 ;Assign to POSTMASTER
- .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",14)=DT
- I $G(PSAGUI)=1 K PSAGUI G QTY
- ;If order unit is standard order unit, set IEN in ^XTMP
- S PSAUOM=$O(^DIC(51.5,"B",$P($P(PSADATA,"^",2),"~"),0))
- I 'PSAUOM D Q:'PSAOK
- .I +$P(PSADATA,"^",6),+$P(PSADATA,"^",7),+$P($G(^PSDRUG(PSAIEN,1,+$P(PSADATA,"^",7),0)),"^",5) D
- ..S PSAUOM=+$P($G(^PSDRUG(PSAIEN,1,+$P(PSADATA,"^",7),0)),"^",5),PSAUOMN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2),"~")
- ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOMN_"~"_PSAUOM K PSAUOMN
- .S:'PSAUOM PSAOK=0
- I PSAUOM S PSAUOMN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2),"~"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOMN_"~"_PSAUOM K PSAUOMN
- ;
- QTY ;If qty is 0 or blank, set flag
- I '+$P(PSADATA,"^") S PSAOK=0 Q
- ;
- DUOU ;If no dispense units per order unit, set flag.
- S PSADRG=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6),PSASYN=$P(^(PSALINE),"^",7)
- S:'PSASYN PSAOK=0
- I PSASYN,'$P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",7) S PSAOK=0
- Q
- ;
- NDCCHK N TMPSYNDC,TMPDGNDC,TMPSYN01
- I '$G(PSANDC) D
- .S TMPSYN01=$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^")
- .S TMPSYNDC=$TR($P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",2),"-","")
- .S TMPDGNDC=$TR($P(^PSDRUG(PSAIEN,2),"^",4),"-","")
- .I TMPDGNDC=TMPSYNDC,TMPSYN01'=TMPSYNDC S PSANDC=TMPSYNDC Q
- .I $G(TMPSYNDC),'$G(TMPDGNDC) S PSANDC=TMPSYNDC Q
- .I $G(TMPDGNDC),'$G(TMPSYNDC) S PSANDC=TMPDGNDC Q
- .I '$G(TMPDGNDC),'$G(TMPSYNDC),$G(TMPSYN01) S PSANDC="",PSAOK=0 Q
- .I '$G(TMPDGNDC),'$G(TMPSYNDC),'$G(TMPSYN01) S PSANDC="",PSAOK=0
- S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU6 9806 printed Mar 13, 2025@20:53:36 Page 2
- PSABRKU6 ;BIR/DB-Upload and Process Prime Vendor Invoice Data - CONT'D ;10/9/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,48,68**; 10/24/97;Build 7
- +2 ;This routine looks in the DRUG file for each line item on the order.
- +3 ;It looks for the NDC then VSN. If it is not found, no data is stored.
- +4 ;
- +5 ;References to ^DIC(51.5 are covered by IA #1931
- +6 ;References to ^PSDRUG( are covered by IA #2095
- +7 ;Counter for Order Unit conversions
- SET PSAGUI1=0
- +8 ;matched NDC counter
- SET PSAGUI5=0
- +9 ;matched VSN counter
- SET PSAGUI6=0
- +10 ;matched Supply Item counter
- SET PSAGUI7=0
- +11 SET PSACTRL=0
- FOR
- SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
- if PSACTRL=""
- QUIT
- Begin DoDot:1
- +12 IF '$DATA(^XTMP("PSAPV",PSACTRL,"IN"))!($PIECE($GET(^XTMP("PSAPV",PSACTRL,"IN")),"^",8)="P")
- QUIT
- +13 SET PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
- SET PSAORD=$PIECE(PSAIN,"^",4)
- SET PSAINV=$PIECE(PSAIN,"^",2)
- SET PSACS=0
- +14 SET PSALINE=0
- FOR
- SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
- if 'PSALINE
- QUIT
- Begin DoDot:2
- +15 if '$DATA(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
- QUIT
- if $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
- QUIT
- +16 SET PSAOK=1
- SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
- SET PSANDC=$PIECE(PSADATA,"^",4)
- SET PSAVSN=$PIECE(PSADATA,"^",5)
- +17 ;W "."
- DO GETDRUG
- +18 if PSAOK
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="OK"
- +19 ;*48 ORDER UNIT AUTO ADJUST
- if PSAOK
- DO OUAUTO^PSAUP8
- End DoDot:2
- +20 SET (PSACNT,PSALLCS,PSALLOK,PSASUP)=0
- +21 if PSACS
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",9)="CS"
- +22 SET PSALINE=0
- FOR
- SET PSALINE=+$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))
- if 'PSALINE
- QUIT
- Begin DoDot:2
- +23 SET PSACNT=PSACNT+1
- +24 if $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS"
- SET PSALLCS=PSALLCS+1
- +25 if $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="OK"
- SET PSALLOK=PSALLOK+1
- +26 if '+$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)
- SET PSASUP=PSASUP+1
- End DoDot:2
- +27 IF PSACNT=PSASUP
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
- +28 IF PSACNT=PSALLCS
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)="ALL CS"
- +29 IF PSACNT=PSALLOK
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="OK"
- End DoDot:1
- +30 QUIT
- +31 ;
- GETDRUG ;Looks for NDC then VSNs in DRUG file.
- +1 IF $DATA(PSANDC)
- SET PSANDC=$PIECE(PSANDC,"~")
- +2 IF $DATA(PSAVSN)
- SET PSAVSN=$PIECE(PSAVSN,"~")
- +3 if PSANDC=0
- GOTO GETVSN
- +4 IF PSANDC'=""
- SET PSAIEN=+$ORDER(^PSDRUG("C",PSANDC,0))
- IF PSAIEN
- SET PSASUB=+$ORDER(^PSDRUG("C",PSANDC,PSAIEN,0))
- GOTO FOUND
- +5 ;
- GETVSN ;Looks for Vendor Stock Number then NDC.
- +1 IF PSAVSN'=""
- SET PSAIEN=+$ORDER(^PSDRUG("AVSN",PSAVSN,0))
- IF PSAIEN
- SET PSASUB=+$ORDER(^PSDRUG("AVSN",PSAVSN,PSAIEN,0))
- GOTO FOUND
- +2 IF $GET(PSAVSN)'=""
- SET PSAMTCH=0
- SET PSASUPPL=0
- Begin DoDot:1
- +3 FOR
- SET PSAMTCH=$ORDER(^XTMP("PSA SUPPLY",PSAMTCH))
- if PSAMTCH'>0
- QUIT
- SET DATA=^XTMP("PSA SUPPLY",PSAMTCH,0)
- IF $PIECE(DATA,"^",2)=PSAVSN
- Begin DoDot:2
- +4 ;Found match on supply item
- +5 SET ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")="UPLOAD GUI"_"^"_DT_"^"_$PIECE(DATA,"^",1)
- +6 SET PSAGUI7=$GET(PSAGUI7)+1
- SET PSASUPPL=1
- End DoDot:2
- End DoDot:1
- +7 IF $GET(PSASUPPL)>0
- GOTO VSN
- +8 ;
- +9 IF (PSANDC=""&PSAVSN="")
- IF $PIECE(PSADATA,"^",26)'=""
- DO ^PSAUP6
- +10 ;
- +11 if '+$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)
- SET PSAOK=0
- +12 GOTO UOM
- +13 ;
- FOUND ;Store line item data if ordered item was found in DRUG file.
- +1 IF $PIECE($GET(^PSDRUG(PSAIEN,2)),"^",3)["N"
- SET PSACS=1
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS"
- +2 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
- SET $PIECE(^(PSALINE),"^",7)=PSASUB
- +3 ;
- NDC ;If >1 NDC in DRUG file, store how many.
- +1 ;^XTMP $P4=NDC ~ # of nodes with same VSN (if >1 NDC) ~ VSN if different
- +2 ; than one on SYNONYM multiple (if 1 NDC)
- +3 IF PSANDC'=""
- IF $ORDER(^PSDRUG("C",PSANDC,0))
- Begin DoDot:1
- +4 SET (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
- +5 ;
- +6 FOR
- SET PSAIEN50=+$ORDER(^PSDRUG("C",PSANDC,PSAIEN50))
- if 'PSAIEN50
- QUIT
- IF '$DATA(^PSDRUG(PSAIEN50,"I"))
- SET PSASYN=0
- FOR
- SET PSASYN=+$ORDER(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN))
- if 'PSASYN
- QUIT
- Begin DoDot:2
- +7 if '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
- QUIT
- +8 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN
- SET PSAFND=PSAFND+1
- SET PSAFND1=PSAIEN50_"^"_PSASYN
- QUIT
- +9 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN
- SET PSACNT=PSACNT+1
- SET PSACNT1=PSAIEN50_"^"_PSASYN
- End DoDot:2
- +10 ;
- +11 ;If NDC & VSN match, set ^XTMP
- +12 IF PSAFND=1
- SET PSAIEN=$PIECE(PSAFND1,"^")
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
- SET PSASUB=$PIECE(PSAFND1,"^",2)
- SET $PIECE(^(PSALINE),"^",7)=PSASUB
- SET $PIECE(^(PSALINE),"^",4)=PSANDC
- QUIT
- +13 ;
- +14 ;If >1 with same NDC & VSN, set # with same NDC & VSN in ^XTMP & flag
- +15 IF PSAFND>1
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~"_PSAFND
- SET PSAOK=0
- QUIT
- +16 ;
- +17 ;If 1 NDC and ...
- +18 IF PSACNT=1
- SET PSAIEN=$PIECE(PSACNT1,"^")
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
- SET PSASUB=$PIECE(PSACNT1,"^",2)
- SET $PIECE(^(PSALINE),"^",7)=PSASUB
- Begin DoDot:2
- +19 ;VSN is null, accept as found & set ^XTMP
- +20 IF $PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4)=""
- SET PSAIEN=$PIECE(PSACNT1,"^")
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
- SET PSASUB=$PIECE(PSACNT1,"^",2)
- SET $PIECE(^(PSALINE),"^",7)=PSASUB
- SET $PIECE(^(PSALINE),"^",4)=PSANDC
- QUIT
- +21 ;Different VSN, set VSN in NDC piece in ^XTMP
- +22 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~~"_$PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4)
- SET PSAOK=0
- End DoDot:2
- QUIT
- +23 ;
- +24 ;If >1 NDC with different VSN, set flag in NDC piece of ^XTMP
- +25 IF PSACNT>1
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~"_PSACNT
- SET PSAOK=0
- End DoDot:1
- +26 ;
- VSN ;If there >1 VSN with same VSN, store how many.
- +1 ;^XTMP $P5=VSN ~ # of nodes with same UOM (if >1 VSN) ~ NDC if different
- +2 ; than one on SYNONYM multiple (if 1 VSN)
- +3 IF PSAVSN'=""
- IF $ORDER(^PSDRUG("AVSN",PSAVSN,0))
- Begin DoDot:1
- +4 SET (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
- +5 ;
- +6 ;DAVE B (PSA*3*2)
- +7 FOR
- SET PSAIEN50=+$ORDER(^PSDRUG("AVSN",PSAVSN,PSAIEN50))
- if 'PSAIEN50
- QUIT
- IF '$DATA(^PSDRUG(PSAIEN50,"I"))
- SET PSASYN=0
- FOR
- SET PSASYN=+$ORDER(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN))
- if 'PSASYN
- QUIT
- Begin DoDot:2
- +8 if '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
- QUIT
- +9 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC
- SET PSAFND=PSAFND+1
- SET PSAFND1=PSAIEN50_"^"_PSASYN
- QUIT
- +10 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC
- SET PSACNT=PSACNT+1
- SET PSACNT1=PSAIEN50_"^"_PSASYN
- End DoDot:2
- +11 ;
- +12 ;If VSN & NDC match, set ^XTMP
- +13 IF PSAFND=1
- Begin DoDot:2
- +14 IF '+$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)
- Begin DoDot:3
- +15 SET PSAIEN=$PIECE(PSAFND1,"^")
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
- SET PSASUB=$PIECE(PSAFND1,"^",2)
- SET $PIECE(^(PSALINE),"^",7)=PSASUB
- +16 if $PIECE($GET(^PSDRUG(PSAIEN,2)),"^",3)["N"
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS"
- SET PSACS=1
- +17 if $PIECE($GET(^PSDRUG(PSAIEN,2)),"^",3)'["N"
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)=""
- SET PSACS=0
- End DoDot:3
- +18 ;*48
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=+$GET(PSAVSN)
- End DoDot:2
- QUIT
- +19 ;
- +20 ;If >1 with same VSN & NDC, set # with same NDC & VSN in ^XTMP & flag
- +21 IF PSAFND>1
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~"_PSAFND
- SET PSAOK=0
- QUIT
- +22 ;
- +23 ;If 1 VSN and ...
- +24 IF PSACNT=1
- Begin DoDot:2
- +25 IF '+$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)
- SET PSAIEN=$PIECE(PSACNT1,"^")
- SET $PIECE(^(PSALINE),"^",6)=PSAIEN
- SET PSASUB=$PIECE(PSACNT1,"^",2)
- SET $PIECE(^(PSALINE),"^",7)=PSASUB
- +26 ;NDC is null, accept as found & set ^XTMP
- +27 ;I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)="" S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^") Q
- +28 IF $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=""
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
- DO NDCCHK
- QUIT
- +29 ;Different VSN, set VSN in NDC piece in ^XTMP
- +30 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~~"_$PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^")
- SET PSAOK=0
- End DoDot:2
- QUIT
- +31 ;
- +32 ;If >1 VSN with different NDC, set flag in NDC piece of ^XTMP
- +33 IF PSACNT>1
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~"_PSACNT
- SET PSAOK=0
- End DoDot:1
- +34 ;
- UOM ;Locates X12 Unit of Measure Code in ORDER UNIT file.
- +1 ;^XTMP $P2=Alpha OU ~ 51.5 IEN
- +2 KILL PSAUOM,PSAGUI
- IF $PIECE(PSADATA,"^",2)=""
- SET PSAOK=0
- GOTO QTY
- +3 ;
- +4 SET PSAUOM=$PIECE($PIECE(PSADATA,"^",2),"~")
- IF $GET(PSAUOM)'=""
- IF '$DATA(^DIC(51.5,"B",PSAUOM))
- IF $DATA(^PSD(58.812,1,"OU","C",PSALINE))
- Begin DoDot:1
- +5 SET XIEN=$ORDER(^PSD(58.812,1,"OU","C",PSALINE,0))
- IF $PIECE($GET(^PSD(58.812,1,"OU",XIEN,0)),"^",1)=PSAUOM
- SET PSAUOMN=$PIECE(^PSD(58.812,1,"OU",XIEN,0),"^",2)
- SET PSAUOM=$PIECE($GET(^DIC(51.5,PSAUOMN,0)),"^",1)
- SET PSAGUI1=$GET(PSAGUI1)+1
- SET PSAGUI=1
- End DoDot:1
- +6 IF $GET(PSAGUI)=1
- Begin DoDot:1
- +7 ;found unit of measure match in GUI file
- +8 SET PSAUOMN=$ORDER(^DIC(51.5,"B",PSAUOM,0))
- SET PSAGUI=1
- +9 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOM_"~"_PSAUOMN
- +10 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",12)=PSAUOM
- +11 ;Assign to POSTMASTER
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",13)=.5
- +12 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",14)=DT
- End DoDot:1
- +13 IF $GET(PSAGUI)=1
- KILL PSAGUI
- GOTO QTY
- +14 ;If order unit is standard order unit, set IEN in ^XTMP
- +15 SET PSAUOM=$ORDER(^DIC(51.5,"B",$PIECE($PIECE(PSADATA,"^",2),"~"),0))
- +16 IF 'PSAUOM
- Begin DoDot:1
- +17 IF +$PIECE(PSADATA,"^",6)
- IF +$PIECE(PSADATA,"^",7)
- IF +$PIECE($GET(^PSDRUG(PSAIEN,1,+$PIECE(PSADATA,"^",7),0)),"^",5)
- Begin DoDot:2
- +18 SET PSAUOM=+$PIECE($GET(^PSDRUG(PSAIEN,1,+$PIECE(PSADATA,"^",7),0)),"^",5)
- SET PSAUOMN=$PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2),"~")
- +19 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOMN_"~"_PSAUOM
- KILL PSAUOMN
- End DoDot:2
- +20 if 'PSAUOM
- SET PSAOK=0
- End DoDot:1
- if 'PSAOK
- QUIT
- +21 IF PSAUOM
- SET PSAUOMN=$PIECE($PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2),"~")
- SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOMN_"~"_PSAUOM
- KILL PSAUOMN
- +22 ;
- QTY ;If qty is 0 or blank, set flag
- +1 IF '+$PIECE(PSADATA,"^")
- SET PSAOK=0
- QUIT
- +2 ;
- DUOU ;If no dispense units per order unit, set flag.
- +1 SET PSADRG=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)
- SET PSASYN=$PIECE(^(PSALINE),"^",7)
- +2 if 'PSASYN
- SET PSAOK=0
- +3 IF PSASYN
- IF '$PIECE($GET(^PSDRUG(PSADRG,1,PSASYN,0)),"^",7)
- SET PSAOK=0
- +4 QUIT
- +5 ;
- NDCCHK NEW TMPSYNDC,TMPDGNDC,TMPSYN01
- +1 IF '$GET(PSANDC)
- Begin DoDot:1
- +2 SET TMPSYN01=$PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^")
- +3 SET TMPSYNDC=$TRANSLATE($PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^",2),"-","")
- +4 SET TMPDGNDC=$TRANSLATE($PIECE(^PSDRUG(PSAIEN,2),"^",4),"-","")
- +5 IF TMPDGNDC=TMPSYNDC
- IF TMPSYN01'=TMPSYNDC
- SET PSANDC=TMPSYNDC
- QUIT
- +6 IF $GET(TMPSYNDC)
- IF '$GET(TMPDGNDC)
- SET PSANDC=TMPSYNDC
- QUIT
- +7 IF $GET(TMPDGNDC)
- IF '$GET(TMPSYNDC)
- SET PSANDC=TMPDGNDC
- QUIT
- +8 IF '$GET(TMPDGNDC)
- IF '$GET(TMPSYNDC)
- IF $GET(TMPSYN01)
- SET PSANDC=""
- SET PSAOK=0
- QUIT
- +9 IF '$GET(TMPDGNDC)
- IF '$GET(TMPSYNDC)
- IF '$GET(TMPSYN01)
- SET PSANDC=""
- SET PSAOK=0
- End DoDot:1
- +10 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
- +11 QUIT
