PSOSUCLE ;BIR/SAB-utility to resuspended Rxs ;04/11/00
;;7.0;OUTPATIENT PHARMACY;**39**;DEC 1997
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ^DPT supported by DBIA 10035
;
D ^PSOLSET K DIRUT,DUOUT,DIR
W !! S DIR(0)="SA^Q:Queue Background;R:Run while I wait;E:Exit"
S DIR("A",1)="This utility will re-suspend all prescriptions that have not yet printed or have",DIR("A",2)="not been queued for transmission to CMOP."
S DIR("A",3)=" ",DIR("A",4)="Do you want to Queue to run in the background or"
S DIR("B")="Queue",DIR("A")="Run while you wait? " D ^DIR
G:Y="Q" QUE G:X="E"!($D(DIRUT)) EXIT
EN K SUSDAT,XFLAG,PSOQ,^TMP("PSOSUCLE",$J)
F SU=0:0 S SU=$O(^PS(52.5,SU)) Q:'SU I $P(^PS(52.5,SU,0),"^",7)="",$G(^("P"))=0 D
.I $P(^PS(52.5,SU,0),"^",2)="" S $P(^PS(52.5,SU,0),"^",2)=DT
.I $D(^TMP("PSOSUCLE",$J,"RXN",$P(^PS(52.5,SU,0),"^"))) S DA=SU,DIK="^PS(52.5," D ^DIK Q
.S ^TMP("PSOSUCLE",$J,SU,0)=^PS(52.5,SU,0),^TMP("PSOSUCLE",$J,"RXN",$P(^PS(52.5,SU,0),"^"))=""
F SU=0:0 S SU=$O(^TMP("PSOSUCLE",$J,SU)) Q:'SU S SUSDAT=^TMP("PSOSUCLE",$J,SU,0) D REQUE K XFLAG,SUSDAT
EXIT K ^TMP("PSOSUCLE",$J),SU,RXN,DIR,%DT,PSOQ,SD,L,RXN,ACT,X,Y,DIRUT,DUOUT,DTOUT,DIROUT,XFLAG,SUSDAT,PSOSYS S ZTREQ="@"
Q
REQUE S RXN=$P(SUSDAT,"^"),DA=SU,ACT=1,SD=$S($P(SUSDAT,"^",2):$P(SUSDAT,"^",2),1:DT),DIK="^PS(52.5," D ^DIK
I $P($G(^PSRX(RXN,"STA")),"^")=3 Q
I $G(PSXSYS) S DA=RXN D SUS1^PSOCMOP I $G(XFLAG)=1 K XFLAG Q
S RXP=+$P(SUSDAT,"^",5),DIC="^PS(52.5,",DIC(0)="L",X=RXN
S DIC("DR")=".02///"_SD_";.03////"_$P(SUSDAT,"^",3)_";.04///M;.05///"_RXP_";.06////"_$P(SUSDAT,"^",6)_";2///0;6////"_$P(SUSDAT,"^",10)_";8////"_$P(SUSDAT,"^",12)_";9////"_$P(SUSDAT,"^",13)
K DD,DO D FILE^DICN K DD,DO
S LFD=$E(SD,4,5)_"-"_$E(SD,6,7)_"-"_$E(SD,2,3) D ACT
W:$G(PSOQ)'=1 !!,"Rx# "_$P(^PSRX(RXN,0),"^")_" has been Re-suspended until "_LFD_"."
Q
ACT S RXF=0 F I=0:0 S I=$O(^PSRX(RXN,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1
S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RXN,"A",FDA)) Q:'FDA S IR=FDA
S IR=IR+1,^PSRX(RXN,"A",0)="^52.3DA^"_IR_"^"_IR
D NOW^%DTC S ^PSRX(RXN,"A",IR,0)=%_"^S^"_DUZ_"^"_RXF_"^"_"Rx Re-Suspended until "_LFD K RXF,I,FDA,DIC,DIE,DR,Y,X,%,%H,%I,IR
Q
QUE ;queues job to background
D NOW^%DTC S %DT(0)=% K %,%H,%I,X
W !! S %DT="AETX",%DT("B")="Now",%DT("A")="Date and Time to Run: " D ^%DT I Y=-1 W !!,"Background Job not queued!",! G EXIT
I $P(Y,".",2)="" W !!,"Date and time Required!",! G QUE
S ZTRTN="EN^PSOSUCLE",ZTIO="",ZTDESC="Outpatient Pharmacy Utility Routine to Re-Suspend Rxs.",ZTDTH=Y,PSOQ=1
F G="PSOQ","DUZ","PSOSYS","PSOPAR","PSOSITE","PSXSYS","PSXVER","PSOINST" S:$D(@G) ZTSAVE(G)=""
D ^%ZTLOAD W:$D(ZTSK) !!,"Background Job Queued to Run.",! K ZTSK G EXIT
Q
RESUS ;resuspends individual Rxs that have printed local but should have gone to CMOP
D ^PSOLSET I '$D(PSOPAR) W !,"No Division Selected!",! Q
S DIC("A")="Select Rx to Re-Suspend: ",DIC=52.5,DIC(0)="AEQMZ",DIC("S")="I $P(^PS(52.5,+Y,0),""^"",7)'=""X"",$G(^(""P""))=1"
D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT)) EXIT G:Y=-1 RESUS
S SU=+Y,SUSDAT=Y(0) D REQUE K Y,XFLAG,SUSDAT,SU G RESUS
Q
SURPT ;prints report of printed Rxs that have cmop drugs
D ^PSOLSET I '$D(PSOPAR) W !,"No Division Selected!",! Q
W !!,"Enter a date range to see Rxs printed locally with CMOP Drugs from suspense within those dates."
BEG W ! K %DT S %DT="AEX",%DT("A")="Start date: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END S (%DT(0),BEGDATE,BEG)=Y
W ! S %DT="AEX",%DT("A")="End date: " D ^%DT K %DT G:Y<0!($D(DTOUT)) END S (END,ENDDATE)=Y
S BEGDATE=BEGDATE-.0001,ENDDATE=ENDDATE+.9999
K %ZIS,IOP,ZTSK,ZTQUEUED S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION G END
K PSOION I $D(IO("Q")) D G END
.S ZTDESC="Report that List Rxs from Suspense with CMOP Drugs.",ZTRTN="ENT^PSOSUCLE",ZTSAVE("ZTREQ")="@"
.F G="BEG","END","BEGDATE","ENDDATE","PSOPAR","PSOSITE" S:$D(@G) ZTSAVE(G)=""
.D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued to Print !!",! K ZTSK,IO("Q")
W !!,"Gathering Rxs, please wait...",! H 1
ENT K ^TMP($J,"PSOREQ")
F Z=BEGDATE:0 S Z=$O(^PS(52.5,"AS",Z)) Q:'Z!(Z>ENDDATE) F X=0:0 S X=$O(^PS(52.5,"AS",Z,X)) Q:'X F M=0:0 S M=$O(^PS(52.5,"AS",Z,X,M)) Q:'M D:M=$G(PSOSITE)
.F Q=0:0 S Q=$O(^PS(52.5,"AS",Z,X,M,Q)) Q:'Q F DA=0:0 S DA=$O(^PS(52.5,"AS",Z,X,M,Q,DA)) Q:'DA D
..I '$D(^PS(52.5,DA,0)) K ^PS(52.5,"AS",Z,X,M,Q,DA) Q
..S RXN=$P(^PS(52.5,DA,0),"^"),DRG=$P(^PSRX(RXN,0),"^",6) Q:'$D(^PSDRUG("AQ",DRG))
..S ^TMP($J,"PSOREQ",DA,0)=RXN I $P(^PS(52.5,DA,0),"^",2)="" S $P(^PS(52.5,DA,0),"^",2)=Z
D LIST
END K ^TMP($J,"PSOREQ"),%DT,%ZIS,BEGDATE,DUOUT,DTOUT,ENDDATE,G,INRX,L,M,POP,X,ZZZZ,BEG,END,DRG,RXN,DRG D ^%ZISC
Q
LIST D HEAD I '$O(^TMP($J,"PSOREQ",0)) U IO W !!,"There are no locally printed CMOP Rxs printed for specified date range!",! Q
F L=0:0 S L=$O(^TMP($J,"PSOREQ",L)) Q:'L!($G(PSOOUT)) I $D(^PS(52.5,L,0)) S INRX=$P(^(0),"^") I $D(^PSRX(INRX,0)) S DRG=$P(^(0),"^",6) D
.W !,$P(^PSRX(INRX,0),"^"),?20,$P($G(^DPT(+$P(^PSRX(INRX,0),"^",2),0)),"^"),?60,$S($P($G(^PS(52.5,L,0)),"^",5):"(PARTIAL)",$P($G(^(0)),"^",12):"(REPRINT)",1:"")
.W ?60,$E($P(^PS(52.5,L,0),"^",8),4,5)_"/"_$E($P(^PS(52.5,L,0),"^",8),6,7)_"/"_$E($P(^PS(52.5,L,0),"^",8),2,3),!?5,"Drug: "_$P($G(^PSDRUG(DRG,0)),"^")
.D:($Y+5)>IOSL HEADONE
W !,$S('$G(PSOOUT):"End of List",1:"Printout Terminated")
Q
HEAD U IO W @IOF,!?20,"Rxs Printed Locally that have CMOP Drugs"
W !,"Date Range Requested: "_$E(BEG,4,5)_"/"_$E(BEG,6,7)_"/"_$E(BEG,2,3)_" to "_$E(END,4,5)_"/"_$E(END,6,7)_"/"_$E(END,2,3),!
W ! W "Rx #",?20,"Patient Name",?60,"Date Printed",!
F ZZZZ=1:1:78 W "-"
Q
HEADONE I '$D(ZTSK) S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
D HEAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSUCLE 5746 printed Sep 23, 2025@20:11:48 Page 2
PSOSUCLE ;BIR/SAB-utility to resuspended Rxs ;04/11/00
+1 ;;7.0;OUTPATIENT PHARMACY;**39**;DEC 1997
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External reference to ^DPT supported by DBIA 10035
+4 ;
+5 DO ^PSOLSET
KILL DIRUT,DUOUT,DIR
+6 WRITE !!
SET DIR(0)="SA^Q:Queue Background;R:Run while I wait;E:Exit"
+7 SET DIR("A",1)="This utility will re-suspend all prescriptions that have not yet printed or have"
SET DIR("A",2)="not been queued for transmission to CMOP."
+8 SET DIR("A",3)=" "
SET DIR("A",4)="Do you want to Queue to run in the background or"
+9 SET DIR("B")="Queue"
SET DIR("A")="Run while you wait? "
DO ^DIR
+10 if Y="Q"
GOTO QUE
if X="E"!($DATA(DIRUT))
GOTO EXIT
EN KILL SUSDAT,XFLAG,PSOQ,^TMP("PSOSUCLE",$JOB)
+1 FOR SU=0:0
SET SU=$ORDER(^PS(52.5,SU))
if 'SU
QUIT
IF $PIECE(^PS(52.5,SU,0),"^",7)=""
IF $GET(^("P"))=0
Begin DoDot:1
+2 IF $PIECE(^PS(52.5,SU,0),"^",2)=""
SET $PIECE(^PS(52.5,SU,0),"^",2)=DT
+3 IF $DATA(^TMP("PSOSUCLE",$JOB,"RXN",$PIECE(^PS(52.5,SU,0),"^")))
SET DA=SU
SET DIK="^PS(52.5,"
DO ^DIK
QUIT
+4 SET ^TMP("PSOSUCLE",$JOB,SU,0)=^PS(52.5,SU,0)
SET ^TMP("PSOSUCLE",$JOB,"RXN",$PIECE(^PS(52.5,SU,0),"^"))=""
End DoDot:1
+5 FOR SU=0:0
SET SU=$ORDER(^TMP("PSOSUCLE",$JOB,SU))
if 'SU
QUIT
SET SUSDAT=^TMP("PSOSUCLE",$JOB,SU,0)
DO REQUE
KILL XFLAG,SUSDAT
EXIT KILL ^TMP("PSOSUCLE",$JOB),SU,RXN,DIR,%DT,PSOQ,SD,L,RXN,ACT,X,Y,DIRUT,DUOUT,DTOUT,DIROUT,XFLAG,SUSDAT,PSOSYS
SET ZTREQ="@"
+1 QUIT
REQUE SET RXN=$PIECE(SUSDAT,"^")
SET DA=SU
SET ACT=1
SET SD=$SELECT($PIECE(SUSDAT,"^",2):$PIECE(SUSDAT,"^",2),1:DT)
SET DIK="^PS(52.5,"
DO ^DIK
+1 IF $PIECE($GET(^PSRX(RXN,"STA")),"^")=3
QUIT
+2 IF $GET(PSXSYS)
SET DA=RXN
DO SUS1^PSOCMOP
IF $GET(XFLAG)=1
KILL XFLAG
QUIT
+3 SET RXP=+$PIECE(SUSDAT,"^",5)
SET DIC="^PS(52.5,"
SET DIC(0)="L"
SET X=RXN
+4 SET DIC("DR")=".02///"_SD_";.03////"_$PIECE(SUSDAT,"^",3)_";.04///M;.05///"_RXP_";.06////"_$PIECE(SUSDAT,"^",6)_";2///0;6////"_$PIECE(SUSDAT,"^",10)_";8////"_$PIECE(SUSDAT,"^",12)_";9////"_$PIECE(SUSDAT,"^",13)
+5 KILL DD,DO
DO FILE^DICN
KILL DD,DO
+6 SET LFD=$EXTRACT(SD,4,5)_"-"_$EXTRACT(SD,6,7)_"-"_$EXTRACT(SD,2,3)
DO ACT
+7 if $GET(PSOQ)'=1
WRITE !!,"Rx# "_$PIECE(^PSRX(RXN,0),"^")_" has been Re-suspended until "_LFD_"."
+8 QUIT
ACT SET RXF=0
FOR I=0:0
SET I=$ORDER(^PSRX(RXN,1,I))
if 'I
QUIT
SET RXF=I
if I>5
SET RXF=I+1
+1 SET IR=0
FOR FDA=0:0
SET FDA=$ORDER(^PSRX(RXN,"A",FDA))
if 'FDA
QUIT
SET IR=FDA
+2 SET IR=IR+1
SET ^PSRX(RXN,"A",0)="^52.3DA^"_IR_"^"_IR
+3 DO NOW^%DTC
SET ^PSRX(RXN,"A",IR,0)=%_"^S^"_DUZ_"^"_RXF_"^"_"Rx Re-Suspended until "_LFD
KILL RXF,I,FDA,DIC,DIE,DR,Y,X,%,%H,%I,IR
+4 QUIT
QUE ;queues job to background
+1 DO NOW^%DTC
SET %DT(0)=%
KILL %,%H,%I,X
+2 WRITE !!
SET %DT="AETX"
SET %DT("B")="Now"
SET %DT("A")="Date and Time to Run: "
DO ^%DT
IF Y=-1
WRITE !!,"Background Job not queued!",!
GOTO EXIT
+3 IF $PIECE(Y,".",2)=""
WRITE !!,"Date and time Required!",!
GOTO QUE
+4 SET ZTRTN="EN^PSOSUCLE"
SET ZTIO=""
SET ZTDESC="Outpatient Pharmacy Utility Routine to Re-Suspend Rxs."
SET ZTDTH=Y
SET PSOQ=1
+5 FOR G="PSOQ","DUZ","PSOSYS","PSOPAR","PSOSITE","PSXSYS","PSXVER","PSOINST"
if $DATA(@G)
SET ZTSAVE(G)=""
+6 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Background Job Queued to Run.",!
KILL ZTSK
GOTO EXIT
+7 QUIT
RESUS ;resuspends individual Rxs that have printed local but should have gone to CMOP
+1 DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE !,"No Division Selected!",!
QUIT
+2 SET DIC("A")="Select Rx to Re-Suspend: "
SET DIC=52.5
SET DIC(0)="AEQMZ"
SET DIC("S")="I $P(^PS(52.5,+Y,0),""^"",7)'=""X"",$G(^(""P""))=1"
+3 DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
if Y=-1
GOTO RESUS
+4 SET SU=+Y
SET SUSDAT=Y(0)
DO REQUE
KILL Y,XFLAG,SUSDAT,SU
GOTO RESUS
+5 QUIT
SURPT ;prints report of printed Rxs that have cmop drugs
+1 DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE !,"No Division Selected!",!
QUIT
+2 WRITE !!,"Enter a date range to see Rxs printed locally with CMOP Drugs from suspense within those dates."
BEG WRITE !
KILL %DT
SET %DT="AEX"
SET %DT("A")="Start date: "
DO ^%DT
KILL %DT
if Y<0!($DATA(DTOUT))
GOTO END
SET (%DT(0),BEGDATE,BEG)=Y
+1 WRITE !
SET %DT="AEX"
SET %DT("A")="End date: "
DO ^%DT
KILL %DT
if Y<0!($DATA(DTOUT))
GOTO END
SET (END,ENDDATE)=Y
+2 SET BEGDATE=BEGDATE-.0001
SET ENDDATE=ENDDATE+.9999
+3 KILL %ZIS,IOP,ZTSK,ZTQUEUED
SET PSOION=ION
SET %ZIS="QM"
DO ^%ZIS
KILL %ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
KILL IOP,PSOION
GOTO END
+4 KILL PSOION
IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTDESC="Report that List Rxs from Suspense with CMOP Drugs."
SET ZTRTN="ENT^PSOSUCLE"
SET ZTSAVE("ZTREQ")="@"
+6 FOR G="BEG","END","BEGDATE","ENDDATE","PSOPAR","PSOSITE"
if $DATA(@G)
SET ZTSAVE(G)=""
+7 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report Queued to Print !!",!
KILL ZTSK,IO("Q")
End DoDot:1
GOTO END
+8 WRITE !!,"Gathering Rxs, please wait...",!
HANG 1
ENT KILL ^TMP($JOB,"PSOREQ")
+1 FOR Z=BEGDATE:0
SET Z=$ORDER(^PS(52.5,"AS",Z))
if 'Z!(Z>ENDDATE)
QUIT
FOR X=0:0
SET X=$ORDER(^PS(52.5,"AS",Z,X))
if 'X
QUIT
FOR M=0:0
SET M=$ORDER(^PS(52.5,"AS",Z,X,M))
if 'M
QUIT
if M=$GET(PSOSITE)
Begin DoDot:1
+2 FOR Q=0:0
SET Q=$ORDER(^PS(52.5,"AS",Z,X,M,Q))
if 'Q
QUIT
FOR DA=0:0
SET DA=$ORDER(^PS(52.5,"AS",Z,X,M,Q,DA))
if 'DA
QUIT
Begin DoDot:2
+3 IF '$DATA(^PS(52.5,DA,0))
KILL ^PS(52.5,"AS",Z,X,M,Q,DA)
QUIT
+4 SET RXN=$PIECE(^PS(52.5,DA,0),"^")
SET DRG=$PIECE(^PSRX(RXN,0),"^",6)
if '$DATA(^PSDRUG("AQ",DRG))
QUIT
+5 SET ^TMP($JOB,"PSOREQ",DA,0)=RXN
IF $PIECE(^PS(52.5,DA,0),"^",2)=""
SET $PIECE(^PS(52.5,DA,0),"^",2)=Z
End DoDot:2
End DoDot:1
+6 DO LIST
END KILL ^TMP($JOB,"PSOREQ"),%DT,%ZIS,BEGDATE,DUOUT,DTOUT,ENDDATE,G,INRX,L,M,POP,X,ZZZZ,BEG,END,DRG,RXN,DRG
DO ^%ZISC
+1 QUIT
LIST DO HEAD
IF '$ORDER(^TMP($JOB,"PSOREQ",0))
USE IO
WRITE !!,"There are no locally printed CMOP Rxs printed for specified date range!",!
QUIT
+1 FOR L=0:0
SET L=$ORDER(^TMP($JOB,"PSOREQ",L))
if 'L!($GET(PSOOUT))
QUIT
IF $DATA(^PS(52.5,L,0))
SET INRX=$PIECE(^(0),"^")
IF $DATA(^PSRX(INRX,0))
SET DRG=$PIECE(^(0),"^",6)
Begin DoDot:1
+2 WRITE !,$PIECE(^PSRX(INRX,0),"^"),?20,$PIECE($GET(^DPT(+$PIECE(^PSRX(INRX,0),"^",2),0)),"^"),?60,$SELECT($PIECE($GET(^PS(52.5,L,0)),"^",5):"(PARTIAL)",$PIECE($GET(^(0)),"^",12):"(REPRINT)",1:"")
+3 WRITE ?60,$EXTRACT($PIECE(^PS(52.5,L,0),"^",8),4,5)_"/"_$EXTRACT($PIECE(^PS(52.5,L,0),"^",8),6,7)_"/"_$EXTRACT($PIECE(^PS(52.5,L,0),"^",8),2,3),!?5,"Drug: "_$PIECE($GET(^PSDRUG(DRG,0)),"^")
+4 if ($Y+5)>IOSL
DO HEADONE
End DoDot:1
+5 WRITE !,$SELECT('$GET(PSOOUT):"End of List",1:"Printout Terminated")
+6 QUIT
HEAD USE IO
WRITE @IOF,!?20,"Rxs Printed Locally that have CMOP Drugs"
+1 WRITE !,"Date Range Requested: "_$EXTRACT(BEG,4,5)_"/"_$EXTRACT(BEG,6,7)_"/"_$EXTRACT(BEG,2,3)_" to "_$EXTRACT(END,4,5)_"/"_$EXTRACT(END,6,7)_"/"_$EXTRACT(END,2,3),!
+2 WRITE !
WRITE "Rx #",?20,"Patient Name",?60,"Date Printed",!
+3 FOR ZZZZ=1:1:78
WRITE "-"
+4 QUIT
HEADONE IF '$DATA(ZTSK)
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSOOUT=1
QUIT
+1 DO HEAD
+2 QUIT
