Routine: PSAUTL4

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,!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAUTL4   5313     printed  Mar 13, 2025@20:55:35                                                                                                                                                                                                     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

PSAUTL4.m