PSDACT1 ;BIR/JPW,BJW-Print Daily Activity Log (cont'd) ; 17 Jun 98
;;3.0;CONTROLLED SUBSTANCES ;**10,14,30,65,84**;13 Feb 97;Build 15
;Reference to ^PRC(442 supported by IA #682
;Reference to ^PRCS(410 supported by IA #198
;Reference to ^PSDRUG( supported by IA #221
;Reference to ^PSRX( supported by IA #986
;Reference to ^DD(58.81 supported by IA #10154
;Reference to PSD(58.8 supported by DBIA # 2711
;Reference to PSD(58.81 supported by DBIA # 2808
;References to PSD(58.84 supported by IA # 3485
;modified for nois:tua-0498-32173,new code added to t6
;op v.7 chg the status loc in file 52
START ;entry for compile
K ^TMP("PSDACT",$J)
I $D(ALL) F PSDR=0:0 S PSDR=$O(^PSD(58.8,+PSDS,1,PSDR)) Q:'PSDR I $D(^PSD(58.8,+PSDS,1,PSDR,0)) S PSDRG(+PSDR)=""
I $D(PSDALL) F PSDR=0:0 S PSDR=$O(^PSD(58.8,+PSDS,1,PSDR)) Q:'PSDR D ;rtw added NSR20171111
. I $D(^PSD(58.8,+PSDS,1,PSDR,0)) I $P(^PSDRUG(+PSDR,0),U,3)["2" S PSDRG(+PSDR)="" ;rtw added NSR20171111
F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"ACT",PSD)) Q:'PSD!(PSD>PSDED) F PSDR=0:0 S PSDR=$O(^PSD(58.81,"ACT",PSD,PSDS,PSDR)) Q:'PSDR D
.Q:'$D(PSDRG(PSDR))
.F TYP=0:0 S TYP=$O(^PSD(58.81,"ACT",PSD,PSDS,PSDR,TYP)) Q:'TYP!(TYP=12) F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ACT",PSD,PSDS,PSDR,TYP,PSDA)) Q:'PSDA D SET
G:$D(ZTQUEUED) PRTQUE G PRINT^PSDACT2
END ;
D KVAR^VADPT
K %,%DT,%H,%I,%ZIS,ACT,ALL,BFWD,C,DA,DATE,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,MFG,NAOU,NODE,NQTY,NUM
K PAT,PG,PHARM,POP,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDIO,PSDOUT,PSDPN,PSDR,PSDRG,PSDRGN,PSDS,PSDSD,PSDSN,PSDUZ,PSDUZN,RX,TEXT,TYP,QTY,TYPE,X,Y,VA("BID"),VA("PID")
K ^TMP("PSDACT",$J),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
K PSDALL ;rtw added NSR20171111
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
SET ;sets data
;Dave B (PSD*3*14) Disregard if type is 15.
Q:'$D(^PSD(58.81,PSDA,0)) Q:TYP=5 Q:TYP=15 S NODE=^(0),QTY=$P(NODE,"^",6),BFWD=$P(NODE,"^",10)
S PSDRGN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR_" NAME MISSING")
S PSDUZ=$S(TYP=3:+$P($G(^PSD(58.81,PSDA,1)),"^",14),TYP=4:+$P($G(^PSD(58.81,PSDA,1)),"^",14),TYP=13:+$P($G(^PSD(58.81,PSDA,5)),"^",2),TYP=14:+$P($G(^PSD(58.81,PSDA,4)),"^",2),1:+$P(NODE,"^",7))
S:TYP=2 PSDUZ=$S(+$P($G(^PSD(58.81,PSDA,1)),"^"):+$P($G(^(1)),"^"),1:+$P(NODE,"^",7))
S PSDUZN=$P($G(^VA(200,+PSDUZ,0)),"^"),PSDUZN=$S(PSDUZN]"":$E($P(PSDUZN,",",2))_$E(PSDUZN),1:"**")
I TYP=1 D T1 G TMP
I TYP=2 D T2 G TMP
I TYP=3 Q:'$D(^PSD(58.81,PSDA,3)) D T3 G TMP
Q:TYP=4
I TYP=6 Q:'$D(^PSD(58.81,PSDA,6)) D T6 G TMP
I TYP=7 D T7 G TMP
I TYP=9 D T9 G TMP
I TYP=11 D T11 G TMP
I TYP=13 Q:'$D(^PSD(58.81,PSDA,5)) D T13 G TMP
I TYP=14 Q:'$D(^PSD(58.81,PSDA,4)) D T14 G TMP
I TYP=16 D T16 G TMP
I TYP>18 D TOTH
TMP ;
S PSDUZN=$P($G(^VA(200,+PSDUZ,0)),"^"),PSDUZN=$S(PSDUZN]"":$E($P(PSDUZN,",",2))_$E(PSDUZN),1:"**")
;PSD*3*30 (Dave B - Identify person with more than just **)
I $G(PSDUZN)="**" S PSDUZ=$P($G(^PSD(58.81,PSDA,0)),"^",7),PSDUZN=$P($G(^VA(200,+PSDUZ,0)),"^"),PSDUZN=$S(PSDUZN]"":$E($P(PSDUZN,",",2))_$E(PSDUZN),1:"**")
S ^TMP("PSDACT",$J,PSDRGN,PSD,TYP,PSDA)=BFWD_"^"_NUM_"^"_TEXT_"^"_QTY_"^"_PSDUZN I $D(PSDRTS) S ^TMP("PSDACT",$J,PSDRGN,PSD,TYP,PSDA)=^TMP("PSDACT",$J,PSDRGN,PSD,TYP,PSDA)_"^1"
K PSDRTS Q
T1 S NUM="***",TEXT="RECEIPT INTO PHARMACY"
I $P($G(^PSD(58.81,PSDA,8)),"^")]"" S NUM=$P($G(^PSD(58.81,PSDA,8)),"^") Q
I +$P(NODE,"^",9) S NUM=+$P(NODE,"^",9),NUM=$P($G(^PRC(442,NUM,0)),"^") Q
I +$P(NODE,"^",8) S NUM=+$P(NODE,"^",8),NUM=$P($G(^PRCS(410,NUM,0)),"^") Q
Q
T2 S QTY=-QTY,NUM="DISP",NAOU=+$P(NODE,"^",18) S:NAOU NAOU=$P($G(^PSD(58.8,+NAOU,0)),"^") S TEXT=$S(NAOU]"":NAOU,1:"DISPENSED FROM PHARMACY")
I +$P(NODE,"^",17) S NUM="GS # "_$P(NODE,"^",17)
Q
T3 S NUM="GS # ",TEXT="RETURNED TO STOCK"
I +$P(NODE,"^",17) S NUM=NUM_$P(NODE,"^",17)
;PSD*3*30 (Dave B - more precise infor on RTS)
I $G(NUM)="GS # " D
.S RX=$P($G(^PSD(58.81,PSDA,6)),"^"),RXNUM=$P($G(^PSD(58.81,PSDA,6)),"^",5)
.S PAT=$P($G(^PSRX(RX,0)),"^",2) I PAT S DFN=PAT D PID^VADPT6 S Y=PAT,C=$P(^DD(58.81,73,0),"^",2) D Y^DIQ S TEXT=Y_"("_VA("BID")_")" K DFN,VA("BID"),VA("PID")
.S NUM="RX # "_$G(RXNUM)_" ("_$S($P($G(^PSD(58.81,PSDA,6)),U,2):"R"_$P($G(^(6)),U,2),$P($G(^(6)),U,4):"P"_$P($G(^(6)),U,4),1:"O")_")"
.S QTY=$P(^PSD(58.81,PSDA,3),"^",2),BFWD=$P(^PSD(58.81,PSDA,0),"^",10),PSDRTS=1 Q
I $G(PSDRTS)=1 Q
S QTY=$P(^PSD(58.81,PSDA,3),"^",2),BFWD=$P(^(3),"^",7)
Q
T6 S QTY=-QTY,NUM="RX # ",TEXT="OUTPATIENT RX" N RXNUM
S RX=+$P(^PSD(58.81,PSDA,6),"^"),RXNUM=$S($P(^(6),"^",5)]"":$P(^(6),"^",5),$P($G(^PSRX(RX,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),NUM=NUM_RXNUM
S NUM=NUM_" ("_$S($P($G(^PSD(58.81,PSDA,6)),U,2):"R"_$P($G(^(6)),U,2),$P($G(^(6)),U,4):"P"_$P($G(^(6)),U,4),1:"O")_")"
S PAT=+$P($G(^PSRX(RX,0)),"^",2)
S PSDRXIN=RX D VER^PSDOPT
;W !,TEXT," ",RXNUM
S TEXT=$S('$O(^PSRX("B",RXNUM,0)):"RX DELETED",$G(PSDSTA)=13:"RX DELETED",1:"UNKNOWN")
;W !,TEXT
K PSDSTA,PSOVR,PSDRXIN
I PAT S DFN=PAT D PID^VADPT6 D
.K C S Y=PAT,C=$P(^DD(58.81,73,0),"^",2) D Y^DIQ S TEXT=Y_" ("_VA("BID")_")" K DFN,VA("BID"),VA("PID")
Q
T7 S NUM="GS # ",TEXT="CANCEL UNVERIFIED ORDER",QTY=0
I +$P(NODE,"^",17) S NUM=NUM_$P(NODE,"^",17)
Q
T9 S NUM="ADJ",TEXT=$S($D(^PSD(58.81,+PSDA,9)):$P(NODE,"^",16),1:"ADJUSTMENT")
I $P(NODE,"^",16)]"" S TEXT=$P(NODE,"^",16)
I $D(^PSD(58.81,PSDA,3)) S NUM="DEST # "_$P(^(3),"^",8),TEXT="HOLDING FOR DESTRUCTION"
Q
T11 S NUM="***",TEXT="INITIALIZE BALANCE AT SETUP"
Q
T13 S NUM="GS # ",TEXT="CANCEL VERIFIED ORDER"
I +$P(NODE,"^",17) S NUM=NUM_$P(NODE,"^",17)
S QTY=$P(^PSD(58.81,PSDA,5),"^",3),BFWD=$P(^(5),"^",5)
Q
T14 S NUM="GS # ",TEXT="EDIT VERIFIED ORDER"
I +$P(NODE,"^",17) S NUM=NUM_$P(NODE,"^",17)
S:$D(^PSD(58.81,PSDA,8)) TEXT="EDIT VERIFIED INVOICE",NUM=$P(^PSD(58.81,PSDA,8),"^",1) ; <*65-RJS>
S QTY=$P(^PSD(58.81,PSDA,4),"^",4),BFWD=$P(^(4),"^",7)
Q
T16 S NUM="TRV",TEXT="TRANSFER TO VAULT"
Q
TOTH ;Type = 19,20,21,22
S NUM="INV",TEXT=$G(^PSD(58.84,+TYP,0)),QTY=""
Q
PRTQUE ;queues print after compile
K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN="PRINT^PSDACT2",ZTDESC="CS PHARM Print Daily Activity Log",ZTDTH=$H,ZTSAVE("^TMP(""PSDACT"",$J,")="",ZTSAVE("PSDSN")="",ZTSAVE("PSDATE")=""
D ^%ZTLOAD K ZTSK G END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDACT1 6269 printed Dec 13, 2024@01:44:47 Page 2
PSDACT1 ;BIR/JPW,BJW-Print Daily Activity Log (cont'd) ; 17 Jun 98
+1 ;;3.0;CONTROLLED SUBSTANCES ;**10,14,30,65,84**;13 Feb 97;Build 15
+2 ;Reference to ^PRC(442 supported by IA #682
+3 ;Reference to ^PRCS(410 supported by IA #198
+4 ;Reference to ^PSDRUG( supported by IA #221
+5 ;Reference to ^PSRX( supported by IA #986
+6 ;Reference to ^DD(58.81 supported by IA #10154
+7 ;Reference to PSD(58.8 supported by DBIA # 2711
+8 ;Reference to PSD(58.81 supported by DBIA # 2808
+9 ;References to PSD(58.84 supported by IA # 3485
+10 ;modified for nois:tua-0498-32173,new code added to t6
+11 ;op v.7 chg the status loc in file 52
START ;entry for compile
+1 KILL ^TMP("PSDACT",$JOB)
+2 IF $DATA(ALL)
FOR PSDR=0:0
SET PSDR=$ORDER(^PSD(58.8,+PSDS,1,PSDR))
if 'PSDR
QUIT
IF $DATA(^PSD(58.8,+PSDS,1,PSDR,0))
SET PSDRG(+PSDR)=""
+3 ;rtw added NSR20171111
IF $DATA(PSDALL)
FOR PSDR=0:0
SET PSDR=$ORDER(^PSD(58.8,+PSDS,1,PSDR))
if 'PSDR
QUIT
Begin DoDot:1
+4 ;rtw added NSR20171111
IF $DATA(^PSD(58.8,+PSDS,1,PSDR,0))
IF $PIECE(^PSDRUG(+PSDR,0),U,3)["2"
SET PSDRG(+PSDR)=""
End DoDot:1
+5 FOR PSD=PSDSD:0
SET PSD=$ORDER(^PSD(58.81,"ACT",PSD))
if 'PSD!(PSD>PSDED)
QUIT
FOR PSDR=0:0
SET PSDR=$ORDER(^PSD(58.81,"ACT",PSD,PSDS,PSDR))
if 'PSDR
QUIT
Begin DoDot:1
+6 if '$DATA(PSDRG(PSDR))
QUIT
+7 FOR TYP=0:0
SET TYP=$ORDER(^PSD(58.81,"ACT",PSD,PSDS,PSDR,TYP))
if 'TYP!(TYP=12)
QUIT
FOR PSDA=0:0
SET PSDA=$ORDER(^PSD(58.81,"ACT",PSD,PSDS,PSDR,TYP,PSDA))
if 'PSDA
QUIT
DO SET
End DoDot:1
+8 if $DATA(ZTQUEUED)
GOTO PRTQUE
GOTO PRINT^PSDACT2
END ;
+1 DO KVAR^VADPT
+2 KILL %,%DT,%H,%I,%ZIS,ACT,ALL,BFWD,C,DA,DATE,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,MFG,NAOU,NODE,NQTY,NUM
+3 KILL PAT,PG,PHARM,POP,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDIO,PSDOUT,PSDPN,PSDR,PSDRG,PSDRGN,PSDS,PSDSD,PSDSN,PSDUZ,PSDUZN,RX,TEXT,TYP,QTY,TYPE,X,Y,VA("BID"),VA("PID")
+4 KILL ^TMP("PSDACT",$JOB),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+5 ;rtw added NSR20171111
KILL PSDALL
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
SET ;sets data
+1 ;Dave B (PSD*3*14) Disregard if type is 15.
+2 if '$DATA(^PSD(58.81,PSDA,0))
QUIT
if TYP=5
QUIT
if TYP=15
QUIT
SET NODE=^(0)
SET QTY=$PIECE(NODE,"^",6)
SET BFWD=$PIECE(NODE,"^",10)
+3 SET PSDRGN=$SELECT($PIECE($GET(^PSDRUG(PSDR,0)),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_PSDR_" NAME MISSING")
+4 SET PSDUZ=$SELECT(TYP=3:+$PIECE($GET(^PSD(58.81,PSDA,1)),"^",14),TYP=4:+$PIECE($GET(^PSD(58.81,PSDA,1)),"^",14),TYP=13:+$PIECE($GET(^PSD(58.81,PSDA,5)),"^",2),TYP=14:+$PIECE($GET(^PSD(58.81,PSDA,4)),"^",2),1:+$PIECE(NODE,"^",7))
+5 if TYP=2
SET PSDUZ=$SELECT(+$PIECE($GET(^PSD(58.81,PSDA,1)),"^"):+$PIECE($GET(^(1)),"^"),1:+$PIECE(NODE,"^",7))
+6 SET PSDUZN=$PIECE($GET(^VA(200,+PSDUZ,0)),"^")
SET PSDUZN=$SELECT(PSDUZN]"":$EXTRACT($PIECE(PSDUZN,",",2))_$EXTRACT(PSDUZN),1:"**")
+7 IF TYP=1
DO T1
GOTO TMP
+8 IF TYP=2
DO T2
GOTO TMP
+9 IF TYP=3
if '$DATA(^PSD(58.81,PSDA,3))
QUIT
DO T3
GOTO TMP
+10 if TYP=4
QUIT
+11 IF TYP=6
if '$DATA(^PSD(58.81,PSDA,6))
QUIT
DO T6
GOTO TMP
+12 IF TYP=7
DO T7
GOTO TMP
+13 IF TYP=9
DO T9
GOTO TMP
+14 IF TYP=11
DO T11
GOTO TMP
+15 IF TYP=13
if '$DATA(^PSD(58.81,PSDA,5))
QUIT
DO T13
GOTO TMP
+16 IF TYP=14
if '$DATA(^PSD(58.81,PSDA,4))
QUIT
DO T14
GOTO TMP
+17 IF TYP=16
DO T16
GOTO TMP
+18 IF TYP>18
DO TOTH
TMP ;
+1 SET PSDUZN=$PIECE($GET(^VA(200,+PSDUZ,0)),"^")
SET PSDUZN=$SELECT(PSDUZN]"":$EXTRACT($PIECE(PSDUZN,",",2))_$EXTRACT(PSDUZN),1:"**")
+2 ;PSD*3*30 (Dave B - Identify person with more than just **)
+3 IF $GET(PSDUZN)="**"
SET PSDUZ=$PIECE($GET(^PSD(58.81,PSDA,0)),"^",7)
SET PSDUZN=$PIECE($GET(^VA(200,+PSDUZ,0)),"^")
SET PSDUZN=$SELECT(PSDUZN]"":$EXTRACT($PIECE(PSDUZN,",",2))_$EXTRACT(PSDUZN),1:"**")
+4 SET ^TMP("PSDACT",$JOB,PSDRGN,PSD,TYP,PSDA)=BFWD_"^"_NUM_"^"_TEXT_"^"_QTY_"^"_PSDUZN
IF $DATA(PSDRTS)
SET ^TMP("PSDACT",$JOB,PSDRGN,PSD,TYP,PSDA)=^TMP("PSDACT",$JOB,PSDRGN,PSD,TYP,PSDA)_"^1"
+5 KILL PSDRTS
QUIT
T1 SET NUM="***"
SET TEXT="RECEIPT INTO PHARMACY"
+1 IF $PIECE($GET(^PSD(58.81,PSDA,8)),"^")]""
SET NUM=$PIECE($GET(^PSD(58.81,PSDA,8)),"^")
QUIT
+2 IF +$PIECE(NODE,"^",9)
SET NUM=+$PIECE(NODE,"^",9)
SET NUM=$PIECE($GET(^PRC(442,NUM,0)),"^")
QUIT
+3 IF +$PIECE(NODE,"^",8)
SET NUM=+$PIECE(NODE,"^",8)
SET NUM=$PIECE($GET(^PRCS(410,NUM,0)),"^")
QUIT
+4 QUIT
T2 SET QTY=-QTY
SET NUM="DISP"
SET NAOU=+$PIECE(NODE,"^",18)
if NAOU
SET NAOU=$PIECE($GET(^PSD(58.8,+NAOU,0)),"^")
SET TEXT=$SELECT(NAOU]"":NAOU,1:"DISPENSED FROM PHARMACY")
+1 IF +$PIECE(NODE,"^",17)
SET NUM="GS # "_$PIECE(NODE,"^",17)
+2 QUIT
T3 SET NUM="GS # "
SET TEXT="RETURNED TO STOCK"
+1 IF +$PIECE(NODE,"^",17)
SET NUM=NUM_$PIECE(NODE,"^",17)
+2 ;PSD*3*30 (Dave B - more precise infor on RTS)
+3 IF $GET(NUM)="GS # "
Begin DoDot:1
+4 SET RX=$PIECE($GET(^PSD(58.81,PSDA,6)),"^")
SET RXNUM=$PIECE($GET(^PSD(58.81,PSDA,6)),"^",5)
+5 SET PAT=$PIECE($GET(^PSRX(RX,0)),"^",2)
IF PAT
SET DFN=PAT
DO PID^VADPT6
SET Y=PAT
SET C=$PIECE(^DD(58.81,73,0),"^",2)
DO Y^DIQ
SET TEXT=Y_"("_VA("BID")_")"
KILL DFN,VA("BID"),VA("PID")
+6 SET NUM="RX # "_$GET(RXNUM)_" ("_$SELECT($PIECE($GET(^PSD(58.81,PSDA,6)),U,2):"R"_$PIECE($GET(^(6)),U,2),$PIECE($GET(^(6)),U,4):"P"_$PIECE($GET(^(6)),U,4),1:"O")_")"
+7 SET QTY=$PIECE(^PSD(58.81,PSDA,3),"^",2)
SET BFWD=$PIECE(^PSD(58.81,PSDA,0),"^",10)
SET PSDRTS=1
QUIT
End DoDot:1
+8 IF $GET(PSDRTS)=1
QUIT
+9 SET QTY=$PIECE(^PSD(58.81,PSDA,3),"^",2)
SET BFWD=$PIECE(^(3),"^",7)
+10 QUIT
T6 SET QTY=-QTY
SET NUM="RX # "
SET TEXT="OUTPATIENT RX"
NEW RXNUM
+1 SET RX=+$PIECE(^PSD(58.81,PSDA,6),"^")
SET RXNUM=$SELECT($PIECE(^(6),"^",5)]"":$PIECE(^(6),"^",5),$PIECE($GET(^PSRX(RX,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
SET NUM=NUM_RXNUM
+2 SET NUM=NUM_" ("_$SELECT($PIECE($GET(^PSD(58.81,PSDA,6)),U,2):"R"_$PIECE($GET(^(6)),U,2),$PIECE($GET(^(6)),U,4):"P"_$PIECE($GET(^(6)),U,4),1:"O")_")"
+3 SET PAT=+$PIECE($GET(^PSRX(RX,0)),"^",2)
+4 SET PSDRXIN=RX
DO VER^PSDOPT
+5 ;W !,TEXT," ",RXNUM
+6 SET TEXT=$SELECT('$ORDER(^PSRX("B",RXNUM,0)):"RX DELETED",$GET(PSDSTA)=13:"RX DELETED",1:"UNKNOWN")
+7 ;W !,TEXT
+8 KILL PSDSTA,PSOVR,PSDRXIN
+9 IF PAT
SET DFN=PAT
DO PID^VADPT6
Begin DoDot:1
+10 KILL C
SET Y=PAT
SET C=$PIECE(^DD(58.81,73,0),"^",2)
DO Y^DIQ
SET TEXT=Y_" ("_VA("BID")_")"
KILL DFN,VA("BID"),VA("PID")
End DoDot:1
+11 QUIT
T7 SET NUM="GS # "
SET TEXT="CANCEL UNVERIFIED ORDER"
SET QTY=0
+1 IF +$PIECE(NODE,"^",17)
SET NUM=NUM_$PIECE(NODE,"^",17)
+2 QUIT
T9 SET NUM="ADJ"
SET TEXT=$SELECT($DATA(^PSD(58.81,+PSDA,9)):$PIECE(NODE,"^",16),1:"ADJUSTMENT")
+1 IF $PIECE(NODE,"^",16)]""
SET TEXT=$PIECE(NODE,"^",16)
+2 IF $DATA(^PSD(58.81,PSDA,3))
SET NUM="DEST # "_$PIECE(^(3),"^",8)
SET TEXT="HOLDING FOR DESTRUCTION"
+3 QUIT
T11 SET NUM="***"
SET TEXT="INITIALIZE BALANCE AT SETUP"
+1 QUIT
T13 SET NUM="GS # "
SET TEXT="CANCEL VERIFIED ORDER"
+1 IF +$PIECE(NODE,"^",17)
SET NUM=NUM_$PIECE(NODE,"^",17)
+2 SET QTY=$PIECE(^PSD(58.81,PSDA,5),"^",3)
SET BFWD=$PIECE(^(5),"^",5)
+3 QUIT
T14 SET NUM="GS # "
SET TEXT="EDIT VERIFIED ORDER"
+1 IF +$PIECE(NODE,"^",17)
SET NUM=NUM_$PIECE(NODE,"^",17)
+2 ; <*65-RJS>
if $DATA(^PSD(58.81,PSDA,8))
SET TEXT="EDIT VERIFIED INVOICE"
SET NUM=$PIECE(^PSD(58.81,PSDA,8),"^",1)
+3 SET QTY=$PIECE(^PSD(58.81,PSDA,4),"^",4)
SET BFWD=$PIECE(^(4),"^",7)
+4 QUIT
T16 SET NUM="TRV"
SET TEXT="TRANSFER TO VAULT"
+1 QUIT
TOTH ;Type = 19,20,21,22
+1 SET NUM="INV"
SET TEXT=$GET(^PSD(58.84,+TYP,0))
SET QTY=""
+2 QUIT
PRTQUE ;queues print after compile
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSDIO
SET ZTRTN="PRINT^PSDACT2"
SET ZTDESC="CS PHARM Print Daily Activity Log"
SET ZTDTH=$HOROLOG
SET ZTSAVE("^TMP(""PSDACT"",$J,")=""
SET ZTSAVE("PSDSN")=""
SET ZTSAVE("PSDATE")=""
+2 DO ^%ZTLOAD
KILL ZTSK
GOTO END
