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 Dec 13, 2024@01:48:57 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
