- 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 Jan 18, 2025@03:36:29 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