PSAUTL4 ;BIR ISC/JMB-Verify Invoices Utility ; 8/19/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,48,54,61,67,71**; 10/24/97;Build 10
;
;References to ^DIC(51.5 are covered by IA #1931
;References to ^PSDRUG( are covered by IA #2095
I $G(PSADICW)=1 S PSALINE=Y
;This routine contains a utility to display a line item ready for
;verification. It is called by PSAVER1 and PSAVER2.
;
VERDISP ;Displays a line item on a processed or verified invoice
W PSALINEN_" "
DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
I $G(PSADJ) D
.S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
.S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
.I PSADJD'?1.N S PSASUP=1
.S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2))
.I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" W "*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S (PSADRG,PSA50IEN)=+PSADJD Q
.I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q
.W ?7,"**"_PSADJD S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD
I '$G(PSADJ) D
.S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0)
.W $S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN")
I PSADRG D
.I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **"
.I $D(^PSDRUG(PSADRG,"I")) W !?5,"** INACTIVE IN DRUG FILE **" Q
.I $P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **"
QTY W !,"Qty Invoiced: "
;No Adj. Qty
S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
;Adj. Qty <-RJS *71 START
I $G(PSADJQ)'="" S PSAQTY=PSADJQ W PSAQTY_" ("_$S($P(PSADATA,"^",3):$P(PSADATA,"^",3),$P(PSADATA,"^",3)=0:0,1:"Blank")_")"
I $G(PSADJQ)="" W $P(PSADATA,"^",3) S PSAQTY=$P(PSADATA,"^",3) ;; <- RJS *71 END
UPC S PSAUPC=$P(PSADATA,U,13) W:PSAUPC'="" ?38,"UPC: "_PSAUPC
OU W !,"Order Unit : "
S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"")
S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5)
S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
;Adj. Order Unit
I PSADJO'="" W $S(+PSADJO&($P($G(^DIC(51.5,+PSADJO,0)),"^")'=""):$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")_")" S PSAOU=+PSADJO
I PSADJO="" W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")
;
NDC S PSANDC=$P(PSADATA,"^",11)
I $E(PSANDC)'="S" W ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX
;
PRICE W !,"Unit Price : $"
S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
;Adj. Unit Price
I $G(PSADJP) D
.I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2))))
.W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")"
.S PSAPRICE=PSADJP
I '$G(PSADJP) D
.S PSAPRICE=+$P(PSADATA,"^",5)
.I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q
.W "Blank"
;
VSN S:$D(PSADATA) PSAVSN=$P(PSADATA,"^",12) ;*48
W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),!
;bgn *67
S PSAP67=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,3,PSALINE,0))
W !,"PV-Drug-Description : ",$S($P(PSAP67,"^",1)'="":$P(PSAP67,"^",1),1:"Unknown")
W ?55,"PV-DUOU : ",$S($P(PSAP67,"^",4)'="":$P(PSAP67,"^",4),1:"Unknown")
W !,"PV-Drug-Generic Name : ",$S($P(PSAP67,"^",2)'="":$P(PSAP67,"^",2),1:"Unknown")
W ?55,"PV-UNITS : ",$S($P(PSAP67,"^",3)'="":$P(PSAP67,"^",3),1:"Unknown"),!
;end *67
VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4)
W !,"Dispense Units: "_$S($P($G(^PSDRUG(+PSADRG,660)),"^",8)'="":$P($G(^PSDRUG(+PSADRG,660)),"^",8),1:"Blank")
VDUOU W !,"Dispense Units Per Order Unit: "_$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7),1:"Blank"),!
;
Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14)
;
STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank")
W "Stock Level : "_PSASTOCK
REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank")
W !,"Reorder Level : "_PSAREORD,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAUTL4 5313 printed Sep 23, 2025@19:26:59 Page 2
PSAUTL4 ;BIR ISC/JMB-Verify Invoices Utility ; 8/19/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,48,54,61,67,71**; 10/24/97;Build 10
+2 ;
+3 ;References to ^DIC(51.5 are covered by IA #1931
+4 ;References to ^PSDRUG( are covered by IA #2095
+5 IF $GET(PSADICW)=1
SET PSALINE=Y
+6 ;This routine contains a utility to display a line item ready for
+7 ;verification. It is called by PSAVER1 and PSAVER2.
+8 ;
VERDISP ;Displays a line item on a processed or verified invoice
+1 WRITE PSALINEN_" "
DRUG SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
+1 IF $GET(PSADJ)
Begin DoDot:1
+2 SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
+3 SET PSADJD=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+4 IF PSADJD'?1.N
SET PSASUP=1
+5 SET PSADRG=$SELECT(PSADJ&('PSASUP):$GET(PSADJD),PSADJ&(PSASUP):0,1:+$PIECE(PSADATA,"^",2))
+6 IF $GET(PSADJD)
IF $LENGTH(PSADJD)=$LENGTH(+PSADJD)
IF $PIECE($GET(^PSDRUG(+PSADJD,0)),"^")'=""
WRITE "*"_$PIECE($GET(^PSDRUG(+PSADJD,0)),"^")
SET (PSADRG,PSA50IEN)=+PSADJD
QUIT
+7 IF $GET(PSADJD)
IF $LENGTH(PSADJD)=$LENGTH(+PSADJD)
IF $PIECE($GET(^PSDRUG(+PSADJD,0)),"^")=""
SET (PSADJ,PSADRG)=0
QUIT
+8 WRITE ?7,"**"_PSADJD
SET PSADJSUP=1
SET (PSADRG,PSA50IEN)=PSADJD
End DoDot:1
+9 IF '$GET(PSADJ)
Begin DoDot:1
+10 SET (PSA50IEN,PSADRG)=$SELECT(+$PIECE(PSADATA,"^",2)&($PIECE($GET(^PSDRUG(+$PIECE(PSADATA,"^",2),0)),"^")'=""):+$PIECE(PSADATA,"^",2),1:0)
+11 WRITE $SELECT(+$PIECE(PSADATA,"^",2)&($PIECE($GET(^PSDRUG(+$PIECE(PSADATA,"^",2),0)),"^")'=""):$PIECE(^PSDRUG(+$PIECE(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN")
End DoDot:1
+12 IF PSADRG
Begin DoDot:1
+13 IF $PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)["N"
WRITE " (Controlled Substance)"
IF $PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",12),1,PSADRG,0)),"^",14)
IF $PIECE($GET(^(0)),"^",14)'>DT
WRITE !,$CHAR(7),$CHAR(7),"** INACTIVE IN MASTER VAULT **"
+14 IF $DATA(^PSDRUG(PSADRG,"I"))
WRITE !?5,"** INACTIVE IN DRUG FILE **"
QUIT
+15 IF $PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",5),1,PSADRG,0)),"^",14)
IF $PIECE($GET(^(0)),"^",14)'>DT
WRITE !,$CHAR(7),$CHAR(7),"** INACTIVE IN PHARMACY LOCATION **"
End DoDot:1
QTY WRITE !,"Qty Invoiced: "
+1 ;No Adj. Qty
+2 SET PSADJQ=""
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
+3 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJQ=$SELECT($PIECE(PSANODE,"^",6)'="":+$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+4 ;Adj. Qty <-RJS *71 START
+5 IF $GET(PSADJQ)'=""
SET PSAQTY=PSADJQ
WRITE PSAQTY_" ("_$SELECT($PIECE(PSADATA,"^",3):$PIECE(PSADATA,"^",3),$PIECE(PSADATA,"^",3)=0:0,1:"Blank")_")"
+6 ;; <- RJS *71 END
IF $GET(PSADJQ)=""
WRITE $PIECE(PSADATA,"^",3)
SET PSAQTY=$PIECE(PSADATA,"^",3)
UPC SET PSAUPC=$PIECE(PSADATA,U,13)
if PSAUPC'=""
WRITE ?38,"UPC: "_PSAUPC
OU WRITE !,"Order Unit : "
+1 SET PSAOU=$SELECT(+$PIECE(PSADATA,"^",4)&($PIECE($GET(^DIC(51.5,+$PIECE(PSADATA,"^",4),0)),"^")'=""):+$PIECE(PSADATA,"^",4),1:"")
+2 SET PSATEMP=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
+3 IF +$PIECE(PSATEMP,"^",3)
IF PSADRG
IF +$PIECE($GET(^PSDRUG(PSADRG,1,+$PIECE(PSATEMP,"^",3),0)),"^",5)
SET PSAOU=+$PIECE(^PSDRUG(PSADRG,1,+$PIECE(PSATEMP,"^",3),0),"^",5)
+4 SET PSADJO=""
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
+5 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJO=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+6 ;Adj. Order Unit
+7 IF PSADJO'=""
WRITE $SELECT(+PSADJO&($PIECE($GET(^DIC(51.5,+PSADJO,0)),"^")'=""):$PIECE($GET(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$SELECT(PSAOU:$PIECE($GET(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")_")"
SET PSAOU=+PSADJO
+8 IF PSADJO=""
WRITE $SELECT(+PSAOU:$PIECE($GET(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")
+9 ;
NDC SET PSANDC=$PIECE(PSADATA,"^",11)
+1 IF $EXTRACT(PSANDC)'="S"
WRITE ?38,"NDC: "
DO PSANDC1^PSAHELP
WRITE PSANDCX
KILL PSANDCX
+2 ;
PRICE WRITE !,"Unit Price : $"
+1 SET PSADJP=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
+2 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJP=$SELECT(+$PIECE(PSANODE,"^",6):+$PIECE(PSANODE,"^",6),1:+$PIECE(PSANODE,"^",2))
+3 ;Adj. Unit Price
+4 IF $GET(PSADJP)
Begin DoDot:1
+5 IF $LENGTH($PIECE(PSADJP,".",2))<2
SET PSADJP=$PIECE(PSADJP,".")_"."_$PIECE(PSADJP,".",2)_$EXTRACT("00",1,(2-$LENGTH($PIECE(PSADJP,".",2))))
+6 WRITE $FNUMBER(PSADJP,",")_" ($"_$SELECT(+$PIECE(PSADATA,"^",5):$FNUMBER($PIECE(PSADATA,"^",5),","),$PIECE(PSADATA,"^",5)=0:"0.00",1:"")_")"
+7 SET PSAPRICE=PSADJP
End DoDot:1
+8 IF '$GET(PSADJP)
Begin DoDot:1
+9 SET PSAPRICE=+$PIECE(PSADATA,"^",5)
+10 IF $GET(PSAPRICE)!(PSAPRICE=0)
WRITE $SELECT($GET(PSAPRICE):PSAPRICE,1:"0.00")
QUIT
+11 WRITE "Blank"
End DoDot:1
+12 ;
VSN ;*48
if $DATA(PSADATA)
SET PSAVSN=$PIECE(PSADATA,"^",12)
+1 WRITE ?38,"VSN: "_$SELECT(PSAVSN'="":PSAVSN,1:"Blank"),!
+2 ;bgn *67
+3 SET PSAP67=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,3,PSALINE,0))
+4 WRITE !,"PV-Drug-Description : ",$SELECT($PIECE(PSAP67,"^",1)'="":$PIECE(PSAP67,"^",1),1:"Unknown")
+5 WRITE ?55,"PV-DUOU : ",$SELECT($PIECE(PSAP67,"^",4)'="":$PIECE(PSAP67,"^",4),1:"Unknown")
+6 WRITE !,"PV-Drug-Generic Name : ",$SELECT($PIECE(PSAP67,"^",2)'="":$PIECE(PSAP67,"^",2),1:"Unknown")
+7 WRITE ?55,"PV-UNITS : ",$SELECT($PIECE(PSAP67,"^",3)'="":$PIECE(PSAP67,"^",3),1:"Unknown"),!
+8 ;end *67
VDU SET PSADUOU=+$PIECE(PSATEMP,"^")
SET PSAREORD=+$PIECE(PSATEMP,"^",2)
SET PSASUB=+$PIECE(PSATEMP,"^",3)
SET PSASTOCK=+$PIECE(PSATEMP,"^",4)
+1 WRITE !,"Dispense Units: "_$SELECT($PIECE($GET(^PSDRUG(+PSADRG,660)),"^",8)'="":$PIECE($GET(^PSDRUG(+PSADRG,660)),"^",8),1:"Blank")
VDUOU WRITE !,"Dispense Units Per Order Unit: "_$SELECT(+PSADUOU:+PSADUOU,+PSASUB&(+$PIECE($GET(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7)):+$PIECE($GET(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7),1:"Blank"),!
+1 ;
+2 if '+$PIECE($GET(^PSD(58.8,+PSALOC,0)),"^",14)
QUIT
+3 ;
STOCK SET PSASTOCK=$SELECT(+PSASTOCK:+PSASTOCK,+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank")
+1 WRITE "Stock Level : "_PSASTOCK
REORDER SET PSAREORD=$SELECT(+PSAREORD:+PSAREORD,+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank")
+1 WRITE !,"Reorder Level : "_PSAREORD,!
+2 QUIT
