PSOMGREP ;BHAM ISC/JMB - DAILY MANAGEMENT REPORT ; 3/30/93
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
BEG G:'$D(RUN) END S SDT=0,SDT=$O(^PS(59.12,"B",SDT)) G:$G(SDT)=""!($L(SDT)'=7) IV S Y=SDT D DD^%DT S PSDT=Y
IV S OK=$O(^PS(50.8,0)) G:OK="" DISP
S IVS=0 F IEN=0:0 S IEN=$O(^PS(50.8,IEN)) Q:'IEN!($L(IVS)=7) F IVS=0:0 S IVS=$O(^PS(50.8,IEN,2,IVS)) S:$L(IVS)=7 IVSDT=IVS Q:$L(IVS)=7!('IVS)
G:$G(IVSDT)="" DISP S Y=IVSDT D DD^%DT S PIVSDT=Y
DISP K OK W:$G(SDT)'=""&(RUN'=4) !!!!?5,"**Prescription data available to print starts with "_PSDT_".**"
I ('$D(SDT)!(SDT=""))&(RUN'=4) W !!?13,$C(7),$C(7),"**There is no prescription data available to print.**",!?8,"Use the Date Range Compile data option to make the data available." K SDT G END
W:$D(IVSDT) !!?10,"**IV data available to print starts with "_PIVSDT_".**"
I '$D(IVSDT) W !!?18,$C(7),$C(7),"**There is no IV data available to print.**" K IVSDT G:RUN=4 END
I '$D(IVSDT)&('$D(SDT)) W !!,"There is no prescription and IV data available to print." G END
I RUN=4 S ANS="A" G PAP
S DVCNT=0 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV S DVCNT=DVCNT+1,DV=DIV
PRTDV S:DVCNT=1 ANS="S",DIV=DV I DVCNT>1 W !! S DIR("A")="Print data for all or a specific division",DIR(0)="SBO^A:ALL;S:SPECIFIC",DIR("?")="Answer 'A' for all if you want to print all divisions' report." D
.S DIR("??")="Answer 'S' for specific if you want to print one division's report." D ^DIR K OUT S:$D(DIRUT) OUT=1 K DIR S ANS=Y
G:$G(OUT) END I ANS="S",DVCNT>1 W ! S DIC("A")="Division: ",DIC=59,DIC(0)="AEMQZ" D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT))!(Y<0) PRTDV S DIV=+Y
PAP W !!,"PLEASE PRINT ON WIDE PAPER, I.E., 132 COLUMNS."
SDT W !! S %DT(0)=-DT,%DT("A")="PRINT MANAGEMENT STATS STARTING: " S %DT="EPXA" D ^%DT G:"^"[X END
I RUN'=4&(Y<$G(SDT)) W !!,$C(7),"Data available to print starts with "_PSDT_".",! G SDT
I RUN=4&(Y<$G(IVSDT)) W !!,$C(7),"Data available to print starts with "_PIVSDT_".",! G SDT
G:Y<0 PRTDV S SDT=Y
EDT W ! S %DT("A")="ENDING STATS DATE: " D ^%DT G:"^"[X END S EDT=Y I Y<0!(SDT>EDT) W $C(7)," INVALID ENDING DATE ???" G EDT
S FND=$O(^PS(59.12,SDT-1)) I RUN'=4,(FND>EDT!(+FND=0)) S Y=SDT X ^DD("DD") S SDATE=Y,Y=EDT X ^DD("DD") S EDATE=Y
I W !!?5,$C(7),$C(7),"**There is no prescription data between "_SDATE_" and "_EDATE_".**",!?7,"Use the Date Range Compile data option to make the data available." G END
QUE K %DT,%ZIS,IOP,ZTSK,DVCNT,PSOION S PSOION=ION,%ZIS("B")="",%ZIS="QM" D ^%ZIS
I POP S IOP=PSOION D ^%ZIS U IO K IOP,PSOION W !,$C(7),$C(7),"Report not Queued!" G END
K DVCNT I $D(IO("Q")) S ZTRTN=$S(RUN="A":"ENQ^PSOMGRP1",RUN=1:"EN^PSOMGRP1",RUN=2:"EN^PSOMGRP2",RUN=3:"EN^PSOMGRP3",1:"EN^PSOMGRP4"),ZTDESC="Outpatient Management Report" F G="SDT","EDT","DIV","ANS","RUN" S:$D(@G) ZTSAVE(G)=""
I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued !" K G,Y,X,%DT G END
D:RUN="A" ENQ^PSOMGRP1 D:RUN=1 EN^PSOMGRP1 D:RUN=2 EN^PSOMGRP2 D:RUN=3 EN^PSOMGRP3 D:RUN=4 EN^PSOMGRP4
END D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
K %,%DT,ANS,BEG,CNT,DIR,DIRUT,DIV,DV,DVMN,DTOUT,DUOUT,EDATE,EDT,END,FND,G,K,I,IEN,IVE,IVS,M1,M2,M3,OUT,PG,POP,PRT,PRV,PDATE,PIVSDT,PSDT,PSOION,RUN,SDATE,SDT,S1,S2,S3,T1,T2,T3,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOMGREP 3205 printed Apr 09, 2024@21:32:46 Page 2
PSOMGREP ;BHAM ISC/JMB - DAILY MANAGEMENT REPORT ; 3/30/93
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
BEG if '$DATA(RUN)
GOTO END
SET SDT=0
SET SDT=$ORDER(^PS(59.12,"B",SDT))
if $GET(SDT)=""!($LENGTH(SDT)'=7)
GOTO IV
SET Y=SDT
DO DD^%DT
SET PSDT=Y
IV SET OK=$ORDER(^PS(50.8,0))
if OK=""
GOTO DISP
+1 SET IVS=0
FOR IEN=0:0
SET IEN=$ORDER(^PS(50.8,IEN))
if 'IEN!($LENGTH(IVS)=7)
QUIT
FOR IVS=0:0
SET IVS=$ORDER(^PS(50.8,IEN,2,IVS))
if $LENGTH(IVS)=7
SET IVSDT=IVS
if $LENGTH(IVS)=7!('IVS)
QUIT
+2 if $GET(IVSDT)=""
GOTO DISP
SET Y=IVSDT
DO DD^%DT
SET PIVSDT=Y
DISP KILL OK
if $GET(SDT)'=""&(RUN'=4)
WRITE !!!!?5,"**Prescription data available to print starts with "_PSDT_".**"
+1 IF ('$DATA(SDT)!(SDT=""))&(RUN'=4)
WRITE !!?13,$CHAR(7),$CHAR(7),"**There is no prescription data available to print.**",!?8,"Use the Date Range Compile data option to make the data available."
KILL SDT
GOTO END
+2 if $DATA(IVSDT)
WRITE !!?10,"**IV data available to print starts with "_PIVSDT_".**"
+3 IF '$DATA(IVSDT)
WRITE !!?18,$CHAR(7),$CHAR(7),"**There is no IV data available to print.**"
KILL IVSDT
if RUN=4
GOTO END
+4 IF '$DATA(IVSDT)&('$DATA(SDT))
WRITE !!,"There is no prescription and IV data available to print."
GOTO END
+5 IF RUN=4
SET ANS="A"
GOTO PAP
+6 SET DVCNT=0
FOR DIV=0:0
SET DIV=$ORDER(^PS(59,DIV))
if 'DIV
QUIT
SET DVCNT=DVCNT+1
SET DV=DIV
PRTDV if DVCNT=1
SET ANS="S"
SET DIV=DV
IF DVCNT>1
WRITE !!
SET DIR("A")="Print data for all or a specific division"
SET DIR(0)="SBO^A:ALL;S:SPECIFIC"
SET DIR("?")="Answer 'A' for all if you want to print all divisions' report."
Begin DoDot:1
+1 SET DIR("??")="Answer 'S' for specific if you want to print one division's report."
DO ^DIR
KILL OUT
if $DATA(DIRUT)
SET OUT=1
KILL DIR
SET ANS=Y
End DoDot:1
+2 if $GET(OUT)
GOTO END
IF ANS="S"
IF DVCNT>1
WRITE !
SET DIC("A")="Division: "
SET DIC=59
SET DIC(0)="AEMQZ"
DO ^DIC
KILL DIC
if $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)
GOTO PRTDV
SET DIV=+Y
PAP WRITE !!,"PLEASE PRINT ON WIDE PAPER, I.E., 132 COLUMNS."
SDT WRITE !!
SET %DT(0)=-DT
SET %DT("A")="PRINT MANAGEMENT STATS STARTING: "
SET %DT="EPXA"
DO ^%DT
if "^"[X
GOTO END
+1 IF RUN'=4&(Y<$GET(SDT))
WRITE !!,$CHAR(7),"Data available to print starts with "_PSDT_".",!
GOTO SDT
+2 IF RUN=4&(Y<$GET(IVSDT))
WRITE !!,$CHAR(7),"Data available to print starts with "_PIVSDT_".",!
GOTO SDT
+3 if Y<0
GOTO PRTDV
SET SDT=Y
EDT WRITE !
SET %DT("A")="ENDING STATS DATE: "
DO ^%DT
if "^"[X
GOTO END
SET EDT=Y
IF Y<0!(SDT>EDT)
WRITE $CHAR(7)," INVALID ENDING DATE ???"
GOTO EDT
+1 SET FND=$ORDER(^PS(59.12,SDT-1))
IF RUN'=4
IF (FND>EDT!(+FND=0))
SET Y=SDT
XECUTE ^DD("DD")
SET SDATE=Y
SET Y=EDT
XECUTE ^DD("DD")
SET EDATE=Y
+2 IF $TEST
WRITE !!?5,$CHAR(7),$CHAR(7),"**There is no prescription data between "_SDATE_" and "_EDATE_".**",!?7,"Use the Date Range Compile data option to make the data available."
GOTO END
QUE KILL %DT,%ZIS,IOP,ZTSK,DVCNT,PSOION
SET PSOION=ION
SET %ZIS("B")=""
SET %ZIS="QM"
DO ^%ZIS
+1 IF POP
SET IOP=PSOION
DO ^%ZIS
USE IO
KILL IOP,PSOION
WRITE !,$CHAR(7),$CHAR(7),"Report not Queued!"
GOTO END
+2 KILL DVCNT
IF $DATA(IO("Q"))
SET ZTRTN=$SELECT(RUN="A":"ENQ^PSOMGRP1",RUN=1:"EN^PSOMGRP1",RUN=2:"EN^PSOMGRP2",RUN=3:"EN^PSOMGRP3",1:"EN^PSOMGRP4")
SET ZTDESC="Outpatient Management Report"
FOR G="SDT","EDT","DIV","ANS","RUN"
if $DATA(@G)
SET ZTSAVE(G)=""
+3 IF $TEST
KILL IO("Q")
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report Queued !"
KILL G,Y,X,%DT
GOTO END
+4 if RUN="A"
DO ENQ^PSOMGRP1
if RUN=1
DO EN^PSOMGRP1
if RUN=2
DO EN^PSOMGRP2
if RUN=3
DO EN^PSOMGRP3
if RUN=4
DO EN^PSOMGRP4
END DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL %,%DT,ANS,BEG,CNT,DIR,DIRUT,DIV,DV,DVMN,DTOUT,DUOUT,EDATE,EDT,END,FND,G,K,I,IEN,IVE,IVS,M1,M2,M3,OUT,PG,POP,PRT,PRV,PDATE,PIVSDT,PSDT,PSOION,RUN,SDATE,SDT,S1,S2,S3,T1,T2,T3,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+2 QUIT
