PSXRSTAT ;BIR/HTW-Rx Workload Report ; 30 Oct 2000 5:08 PM
;;2.0;CMOP;**31**;11 Apr 97
; External reference to ^PSRX( supported by DBIA #1221
; External reference to ^PS(52.5 supported by DBIA #1222
; External reference to ^PS(59 supported by DBIA #1976
;
D EXIT
BEGDATE S DIR(0)="DO",DIR("A")="ENTER BEGINNING DATE " D ^DIR K DIR
G:$D(DIRUT)!(X']"") END
S PSXB=Y K Y,X
I PSXB>DT W !!,"Future dates are not allowed.",! G BEGDATE
ENDDATE S Y=DT X ^DD("DD") S ZZTODAY=Y K Y
K X,Y
S DIR(0)="DO",DIR("A")="ENTER ENDING DATE ",DIR("B")=ZZTODAY
D ^DIR K DIR
G:$D(DIRUT) END
S PSXE=Y K Y
I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
K ZZTODAY
D SEL Q:'$D(DIVDA)
DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
D ^%ZIS G:POP END S PSXLAP=ION
I IOST["C-" G START
I '$D(IO("Q")) G ST0
D ^%ZISC K J,C
QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVDA(")="",ZTSAVE("DIVNM(")="",ZTIO=PSXLAP
S ZTRTN="START^PSXRSTAT"
S ZTDESC="CMOP Rx Workload Report"
D ^%ZTLOAD
Q1 W:$D(ZTSK) !!,"Report Queued to Print!!"
K DIR,PSXB,PSXE,Y
Q
ST0 U IO
;Taskman entry point to start the CMOP Workload Report
START S:$D(ZTQUEUED) ZTREQ="@"
S LINE="W ! F I=1:1:80 W ""="""
K TOTAL,TOTALT
S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:'DIVDA D Q:$G(PSXFLAG)=1
.S (PSXAD,PSXOT)=0,PSXE1=PSXE,PSXXE=PSXE,PSXXB=PSXB
.S PSXD=PSXB-.00001
.S LINE="W ! F I=1:1:80 W ""="""
.D DIVISION X LINE S DIV=DIVDA D DIVSUML
.D END
.S PSXE=PSXXE,PSXB=PSXXB K PSXXE,PSXXE
D GRNDTOT
D ^%ZISC
D END
Q
DIVISION ;
D TITLE
F S PSXD=$O(^PSRX("AD",PSXD)) Q:(+PSXD'>0)!(+PSXD>PSXE1) D ONE I $G(PSXD1)'=PSXD D MAIN Q:$G(PSXFLAG)=1
D GTOTAL
Q
END K PSXD,PSXE,PSXF,PSXAD,PSXOT,PSXR,PSXLINE,PSXE1,PSXD1
K DIR,X,Y,%,PSXUNREL,PSXB,POP,PSXLAP,PSXNOW,ZTDESC,ZTIO,ZTRTN,ZTSAVE
K PSXMW,PSXM,PSXW,A,B,C,D,E,PSXCR,PSXCU,PSXSUSDT,ZTSK,PSXMT,PSXWT
K DIRUT,DTOUT,DUOUT,PSXFLAG,ZDATE,ZZTOT,DIROUT,ZFILL,PSXSTAT
Q
ONE F PSXR=0:0 S PSXR=$O(^PSRX("AD",PSXD,PSXR)) Q:'PSXR D TWO Q:$G(PSXFLAG)=1
Q
TWO S PSXF="" F S PSXF=$O(^PSRX("AD",PSXD,PSXR,PSXF)) Q:($G(PSXF)']"") D COUNT K PSX,PSXREL,PSXMW Q:$G(PSXFLAG)=1
Q
COUNT ;
I PSXF=0 S DIV=$P(^PSRX(PSXR,2),U,9) Q:DIV'=DIVDA
I PSXF>0 S DIV=$P(^PSRX(PSXR,1,PSXF,0),U,9) Q:DIV'=DIVDA
S PSXRNM=$P(^PSRX(PSXR,0),U,1)
I PSXF=0 Q:'$D(^PSRX(PSXR,0)) D
.S PSXMW=$P($G(^PSRX(PSXR,0)),"^",11)
.I $G(PSXMW)="M" S PSXMT=$G(PSXMT)+1 Q
.I $G(PSXMW)="W" S PSXWT=$G(PSXWT)+1
.I PSXRNM'=+PSXRNM S PSXWRN=$G(PSXWRN)+1
I PSXF>0 Q:'$D(^PSRX(PSXR,1,PSXF,0)) D
.S PSXMW=$P($G(^PSRX(PSXR,1,PSXF,0)),"^",2)
.I $G(PSXMW)="M" S PSXMT=$G(PSXMT)+1 Q
.I $G(PSXMW)="W" S PSXWT=$G(PSXWT)+1,PSXWRF=$G(PSXWRF)+1
I $G(PSXMW)="M" S TOTAL("MAIL")=$G(TOTAL("MAIL"))+1
I $G(PSXMW)="W" S TOTAL("WINDOW")=$G(TOTAL("WINDOW"))+1
S PSXAD=PSXAD+1
I $D(^PSRX(PSXR,4,0)) F PSX=0:0 S PSX=$O(^PSRX(PSXR,4,PSX)) Q:'PSX D
.S ZFILL=$P($G(^PSRX(PSXR,4,PSX,0)),"^",3)
.I $G(ZFILL)'=PSXF K ZFILL Q
.S PSXSTAT=$P($G(^PSRX(PSXR,4,PSX,0)),"^",4)
.S PSX(ZFILL)=PSXSTAT
I $G(PSX(PSXF))=1 S PSXCR=$G(PSXCR)+1,TOTAL("CMOP RELEASED")=$G(TOTAL("CMOP RELEASED"))+1 Q
I $G(PSX(PSXF))=0!($G(PSX(PSXF))=2) S PSXCU=$G(PSXCU)+1,TOTAL("CMOP UNRELEASED")=$G(TOTAL("CMOP UNRELEASED"))+1 Q
;Check if in suspense...
I $D(^PS(52.5,"B",PSXR)) S PSXST=$O(^(PSXR,"")) I $D(^PS(52.5,PSXST,0)) D
.S PSXST1=$P($G(^PS(52.5,PSXST,0)),"^",7) Q:$G(PSXST1)']""
.S PSXSUSDT=$P(^PS(52.5,PSXST,0),"^",2)
.I PSXF=0 S PSXFDT=$P($G(^PSRX(PSXR,2)),"^",2)
.I PSXF>0 S PSXFDT=$P($G(^PSRX(PSXR,1,PSXF,0)),"^") Q:'$G(PSXFDT)
.I PSXSUSDT=PSXFDT,(PSXST1="L") S PSX(PSXF)=PSXST1,PSXCU=$G(PSXCU)+1,TOTAL("CMOP RELEASED")=$G(TOTAL("CMOP RELEASED"))+1
K PSXSTAT,ZFILL,PSXST,PSXST1,ZZ,PSXSUS,PSXFDT
I $G(PSX(PSXF))="L" Q
OP I PSXF=0 S PSXREL=$P($G(^PSRX(PSXR,2)),"^",13)
I PSXF>0 S PSXREL=$P($G(^PSRX(PSXR,1,PSXF,0)),"^",18)
I $G(PSXREL),($G(PSXMW)="M") S PSXM=$G(PSXM)+1,TOTAL("OP MAIL")=$G(TOTAL("OP MAIL"))+1 Q
I $G(PSXREL),($G(PSXMW)="W") S PSXW=$G(PSXW)+1,TOTAL("OP WINDOW")=$G(TOTAL("OP WINDOW"))+1 D Q
.I PSXRNM'=+PSXRNM,PSXF=0 S PSXRRN=$G(PSXRRN)+1
.I PSXF>0 S PSXRRF=$G(PSXRRF)+1
S PSXUNREL=$G(PSXUNREL)+1,TOTAL("OTHER")=$G(TOTAL("OTHER"))+1
Q
TITLE Q:$G(PSXFLAG)=1
I IOST["C-" W @IOF
S Y=PSXB X ^DD("DD") S PSXB=Y
S Y=PSXE X ^DD("DD") S PSXE=Y
D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
W !!!,?30,"Rx WORKLOAD BREAKDOWN"_$S($G(ZZTOT)=1:" SUMMARY",1:"")
W !,DIVDA(DIVDA)
W !,"FROM: ",PSXB," TO: ",$P(PSXE,"@")," PRINTED: ",PSXNOW
S PSXLINE=6
X LINE
AHEAD W !,"DATE",?8,"TOTAL",?17,"ENTERED",?35,"OUTPATIENT",?47,"RELEASED",?65,"CMOP",?74,"OTHER"
W !,?8,"MAIL",?17,"WINDOW",?35,"MAIL",?47,"WINDOW",?65,"Released"
W !,?17,"Tot",?23,"Ref",?29,"Rn1",?47,"Tot",?53,"Ref",?59,"Rn1"
X LINE
Q
MAIN I IOST["C-",($G(PSXLINE)>20) D Q:$G(PSXFLAG)=1
.S DIR(0)="E" D ^DIR K DIR I $G(Y)'=1 S PSXFLAG=1 K Y Q
.D TITLE
I IOST'["C-",($G(PSXLINE)>60) W @IOF D TITLE
S PSXUNREL=$G(PSXUNREL)+$G(PSXCU)
S ZDATE=$E(PSXD,4,5)_"/"_$E(PSXD,6,7)
S A=19-($L($G(PSXWT))\2),B=29-($L($G(PSXM))\2),C=40-($L($G(PSXW))\2),D=57-($L($G(PSXCR))\2),E=72-($L($G(PSXUNREL))\2)
;W !,ZDATE,?10,$G(PSXMT),?A,$G(PSXWT),?B,$G(PSXM),?C,$G(PSXW),?D,$G(PSXCR),?E,$G(PSXUNREL)
W !,ZDATE,?8,+$G(PSXMT),?17,+$G(PSXWT),?23,+$G(PSXWRF),?29,+$G(PSXWRN),?35,+$G(PSXM),?47,+$G(PSXW),?53,+$G(PSXRRF),?59,+$G(PSXRRN),?65,+$G(PSXCR),?74,+$G(PSXUNREL)
S PSXD1=PSXD,PSXLINE=$G(PSXLINE)+1
S TOTALT(DIVDA,"WINDOW REFIL")=$G(TOTALT(DIVDA,"WINDOW REFIL"))+$G(PSXWRF)
S TOTALT(DIVDA,"WINDOW RENEW")=$G(TOTALT(DIVDA,"WINDOW RENEW"))+$G(PSXWRN)
S TOTALT(DIVDA,"RELEASE REFIL")=$G(TOTALT(DIVDA,"RELEASE REFIL"))+$G(PSXRRF)
S TOTALT(DIVDA,"RELEASE RENEW")=$G(TOTALT(DIVDA,"RELEASE RENEW"))+$G(PSXRRN)
K PSXMT,PSXWT,PSXCR,PSXCU,PSXM,PSXW,PSXCR,PSXUNREL,PSXWRF,PSXWRN,PSXRRF,PSXRRN
Q
GTOTAL ;
Q:$G(PSXFLAG)=1
F X="MAIL","WINDOW","OP MAIL","OP WINDOW","CMOP RELEASED","CMOP UNRELEASED","OTHER" S TOTALT(DIVDA,X)=$G(TOTAL(X))
K TOTAL
I IOST["C-",($G(PSXLINE)<20) S DIR(0)="E" D ^DIR K DIR Q:(Y="")
Q
GRNDTOT ;EP WRITE /LOOP DIVISIONAL TOTALS & WRITE GRAND TOTALS
Q:$G(PSXFLAG)=1
W @IOF
S DIVDA(0)=" Grand Total Summary",DIVDA=0
D TITLE
S LINE="W ! F I=1:1:80 W ""="""
S DIV=0 F S DIV=$O(DIVDA(DIV)) Q:'DIV D
.D DIVSUM
.F X="MAIL","WINDOW","OP MAIL","OP WINDOW","CMOP RELEASED","CMOP UNRELEASED","OTHER","WINDOW RENEW","WINDOW REFIL","RELEASE REFIL","RELEASE RENEW" S TOTALT(0,X)=$G(TOTALT(0,X))+$G(TOTALT(DIV,X))
X LINE
S DIV=0 D DIVSUML
Q
DIVSUM ;EP DIVISIONAL SUMMARY
Q:$G(PSXFLAG)=1
W !,DIVDA(DIV)
DIVSUML ;
Q:$G(PSXFLAG)=1
W !,?8,+$G(TOTALT(DIV,"MAIL"))
W ?17,+$G(TOTALT(DIV,"WINDOW"))
W ?23,+$G(TOTALT(DIV,"WINDOW REFIL"))
W ?29,+$G(TOTALT(DIV,"WINDOW RENEW"))
W ?35,+$G(TOTALT(DIV,"OP MAIL"))
W ?47,+$G(TOTALT(DIV,"OP WINDOW"))
W ?53,+$G(TOTALT(DIV,"RELEASE REFIL"))
W ?59,+$G(TOTALT(DIV,"RELEASE RENEW"))
W ?65,+$G(TOTALT(DIV,"CMOP RELEASED"))
W ?74,+($G(TOTALT(DIV,"CMOP UNRELEASED"))+$G(TOTALT(DIV,"OTHER")))
I IOST["C-" S DIR(0)="E" D ^DIR K DIR Q:(Y="")
Q
SEL ;Select divisions
; returns arrays
; DIVNM("names of divisions")=selection number
; DIVDA("iens of divisions")=name of division
; for testing
W !!,"SELECTION OF DIVISION(S)",!
S DIV="" K DIVNM,DIVDA,DIVX
F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV="" S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
S I=I-1
K DIR
S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
D ^DIR K DIR
G:Y="A" ALL
G:Y="S" SELECT
Q
SELECT ;
F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
D ^DIR
I '+Y K DIVNM Q
M DIVX=DIVNM K DIVNM
F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
K DIVX,DIR
ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
K DIR
I Y D Q
.K DIVDA
.S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
G SEL
;
TOTALT ;
S X="TOTALT" F S X=$Q(@X) Q:X="" W !,X,?30,@X
Q
EXIT D END
K DIVDA,TOTAL,TOTALT,I,LINE,PSXRRF,PSXXB,PSXRNM,DIV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRSTAT 8309 printed Sep 23, 2025@19:20:58 Page 2
PSXRSTAT ;BIR/HTW-Rx Workload Report ; 30 Oct 2000 5:08 PM
+1 ;;2.0;CMOP;**31**;11 Apr 97
+2 ; External reference to ^PSRX( supported by DBIA #1221
+3 ; External reference to ^PS(52.5 supported by DBIA #1222
+4 ; External reference to ^PS(59 supported by DBIA #1976
+5 ;
+6 DO EXIT
BEGDATE SET DIR(0)="DO"
SET DIR("A")="ENTER BEGINNING DATE "
DO ^DIR
KILL DIR
+1 if $DATA(DIRUT)!(X']"")
GOTO END
+2 SET PSXB=Y
KILL Y,X
+3 IF PSXB>DT
WRITE !!,"Future dates are not allowed.",!
GOTO BEGDATE
ENDDATE SET Y=DT
XECUTE ^DD("DD")
SET ZZTODAY=Y
KILL Y
+1 KILL X,Y
+2 SET DIR(0)="DO"
SET DIR("A")="ENTER ENDING DATE "
SET DIR("B")=ZZTODAY
+3 DO ^DIR
KILL DIR
+4 if $DATA(DIRUT)
GOTO END
+5 SET PSXE=Y
KILL Y
+6 IF PSXE<PSXB
WRITE !,"Ending date must follow beginning date!"
GOTO ENDDATE
+7 KILL ZZTODAY
+8 DO SEL
if '$DATA(DIVDA)
QUIT
DEVICE WRITE !!
SET %ZIS="MQ"
SET %ZIS("A")="Select Printer: "
SET %ZIS("B")=""
+1 DO ^%ZIS
if POP
GOTO END
SET PSXLAP=ION
+2 IF IOST["C-"
GOTO START
+3 IF '$DATA(IO("Q"))
GOTO ST0
+4 DO ^%ZISC
KILL J,C
QUE SET ZTSAVE("PSXB")=""
SET ZTSAVE("PSXE")=""
SET ZTSAVE("DIVDA(")=""
SET ZTSAVE("DIVNM(")=""
SET ZTIO=PSXLAP
+1 SET ZTRTN="START^PSXRSTAT"
+2 SET ZTDESC="CMOP Rx Workload Report"
+3 DO ^%ZTLOAD
Q1 if $DATA(ZTSK)
WRITE !!,"Report Queued to Print!!"
+1 KILL DIR,PSXB,PSXE,Y
+2 QUIT
ST0 USE IO
+1 ;Taskman entry point to start the CMOP Workload Report
START if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 SET LINE="W ! F I=1:1:80 W ""="""
+2 KILL TOTAL,TOTALT
+3 SET DIVDA=0
FOR
SET DIVDA=$ORDER(DIVDA(DIVDA))
if 'DIVDA
QUIT
Begin DoDot:1
+4 SET (PSXAD,PSXOT)=0
SET PSXE1=PSXE
SET PSXXE=PSXE
SET PSXXB=PSXB
+5 SET PSXD=PSXB-.00001
+6 SET LINE="W ! F I=1:1:80 W ""="""
+7 DO DIVISION
XECUTE LINE
SET DIV=DIVDA
DO DIVSUML
+8 DO END
+9 SET PSXE=PSXXE
SET PSXB=PSXXB
KILL PSXXE,PSXXE
End DoDot:1
if $GET(PSXFLAG)=1
QUIT
+10 DO GRNDTOT
+11 DO ^%ZISC
+12 DO END
+13 QUIT
DIVISION ;
+1 DO TITLE
+2 FOR
SET PSXD=$ORDER(^PSRX("AD",PSXD))
if (+PSXD'>0)!(+PSXD>PSXE1)
QUIT
DO ONE
IF $GET(PSXD1)'=PSXD
DO MAIN
if $GET(PSXFLAG)=1
QUIT
+3 DO GTOTAL
+4 QUIT
END KILL PSXD,PSXE,PSXF,PSXAD,PSXOT,PSXR,PSXLINE,PSXE1,PSXD1
+1 KILL DIR,X,Y,%,PSXUNREL,PSXB,POP,PSXLAP,PSXNOW,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+2 KILL PSXMW,PSXM,PSXW,A,B,C,D,E,PSXCR,PSXCU,PSXSUSDT,ZTSK,PSXMT,PSXWT
+3 KILL DIRUT,DTOUT,DUOUT,PSXFLAG,ZDATE,ZZTOT,DIROUT,ZFILL,PSXSTAT
+4 QUIT
ONE FOR PSXR=0:0
SET PSXR=$ORDER(^PSRX("AD",PSXD,PSXR))
if 'PSXR
QUIT
DO TWO
if $GET(PSXFLAG)=1
QUIT
+1 QUIT
TWO SET PSXF=""
FOR
SET PSXF=$ORDER(^PSRX("AD",PSXD,PSXR,PSXF))
if ($GET(PSXF)']"")
QUIT
DO COUNT
KILL PSX,PSXREL,PSXMW
if $GET(PSXFLAG)=1
QUIT
+1 QUIT
COUNT ;
+1 IF PSXF=0
SET DIV=$PIECE(^PSRX(PSXR,2),U,9)
if DIV'=DIVDA
QUIT
+2 IF PSXF>0
SET DIV=$PIECE(^PSRX(PSXR,1,PSXF,0),U,9)
if DIV'=DIVDA
QUIT
+3 SET PSXRNM=$PIECE(^PSRX(PSXR,0),U,1)
+4 IF PSXF=0
if '$DATA(^PSRX(PSXR,0))
QUIT
Begin DoDot:1
+5 SET PSXMW=$PIECE($GET(^PSRX(PSXR,0)),"^",11)
+6 IF $GET(PSXMW)="M"
SET PSXMT=$GET(PSXMT)+1
QUIT
+7 IF $GET(PSXMW)="W"
SET PSXWT=$GET(PSXWT)+1
+8 IF PSXRNM'=+PSXRNM
SET PSXWRN=$GET(PSXWRN)+1
End DoDot:1
+9 IF PSXF>0
if '$DATA(^PSRX(PSXR,1,PSXF,0))
QUIT
Begin DoDot:1
+10 SET PSXMW=$PIECE($GET(^PSRX(PSXR,1,PSXF,0)),"^",2)
+11 IF $GET(PSXMW)="M"
SET PSXMT=$GET(PSXMT)+1
QUIT
+12 IF $GET(PSXMW)="W"
SET PSXWT=$GET(PSXWT)+1
SET PSXWRF=$GET(PSXWRF)+1
End DoDot:1
+13 IF $GET(PSXMW)="M"
SET TOTAL("MAIL")=$GET(TOTAL("MAIL"))+1
+14 IF $GET(PSXMW)="W"
SET TOTAL("WINDOW")=$GET(TOTAL("WINDOW"))+1
+15 SET PSXAD=PSXAD+1
+16 IF $DATA(^PSRX(PSXR,4,0))
FOR PSX=0:0
SET PSX=$ORDER(^PSRX(PSXR,4,PSX))
if 'PSX
QUIT
Begin DoDot:1
+17 SET ZFILL=$PIECE($GET(^PSRX(PSXR,4,PSX,0)),"^",3)
+18 IF $GET(ZFILL)'=PSXF
KILL ZFILL
QUIT
+19 SET PSXSTAT=$PIECE($GET(^PSRX(PSXR,4,PSX,0)),"^",4)
+20 SET PSX(ZFILL)=PSXSTAT
End DoDot:1
+21 IF $GET(PSX(PSXF))=1
SET PSXCR=$GET(PSXCR)+1
SET TOTAL("CMOP RELEASED")=$GET(TOTAL("CMOP RELEASED"))+1
QUIT
+22 IF $GET(PSX(PSXF))=0!($GET(PSX(PSXF))=2)
SET PSXCU=$GET(PSXCU)+1
SET TOTAL("CMOP UNRELEASED")=$GET(TOTAL("CMOP UNRELEASED"))+1
QUIT
+23 ;Check if in suspense...
+24 IF $DATA(^PS(52.5,"B",PSXR))
SET PSXST=$ORDER(^(PSXR,""))
IF $DATA(^PS(52.5,PSXST,0))
Begin DoDot:1
+25 SET PSXST1=$PIECE($GET(^PS(52.5,PSXST,0)),"^",7)
if $GET(PSXST1)']""
QUIT
+26 SET PSXSUSDT=$PIECE(^PS(52.5,PSXST,0),"^",2)
+27 IF PSXF=0
SET PSXFDT=$PIECE($GET(^PSRX(PSXR,2)),"^",2)
+28 IF PSXF>0
SET PSXFDT=$PIECE($GET(^PSRX(PSXR,1,PSXF,0)),"^")
if '$GET(PSXFDT)
QUIT
+29 IF PSXSUSDT=PSXFDT
IF (PSXST1="L")
SET PSX(PSXF)=PSXST1
SET PSXCU=$GET(PSXCU)+1
SET TOTAL("CMOP RELEASED")=$GET(TOTAL("CMOP RELEASED"))+1
End DoDot:1
+30 KILL PSXSTAT,ZFILL,PSXST,PSXST1,ZZ,PSXSUS,PSXFDT
+31 IF $GET(PSX(PSXF))="L"
QUIT
OP IF PSXF=0
SET PSXREL=$PIECE($GET(^PSRX(PSXR,2)),"^",13)
+1 IF PSXF>0
SET PSXREL=$PIECE($GET(^PSRX(PSXR,1,PSXF,0)),"^",18)
+2 IF $GET(PSXREL)
IF ($GET(PSXMW)="M")
SET PSXM=$GET(PSXM)+1
SET TOTAL("OP MAIL")=$GET(TOTAL("OP MAIL"))+1
QUIT
+3 IF $GET(PSXREL)
IF ($GET(PSXMW)="W")
SET PSXW=$GET(PSXW)+1
SET TOTAL("OP WINDOW")=$GET(TOTAL("OP WINDOW"))+1
Begin DoDot:1
+4 IF PSXRNM'=+PSXRNM
IF PSXF=0
SET PSXRRN=$GET(PSXRRN)+1
+5 IF PSXF>0
SET PSXRRF=$GET(PSXRRF)+1
End DoDot:1
QUIT
+6 SET PSXUNREL=$GET(PSXUNREL)+1
SET TOTAL("OTHER")=$GET(TOTAL("OTHER"))+1
+7 QUIT
TITLE if $GET(PSXFLAG)=1
QUIT
+1 IF IOST["C-"
WRITE @IOF
+2 SET Y=PSXB
XECUTE ^DD("DD")
SET PSXB=Y
+3 SET Y=PSXE
XECUTE ^DD("DD")
SET PSXE=Y
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PSXNOW=Y
+5 WRITE !!!,?30,"Rx WORKLOAD BREAKDOWN"_$SELECT($GET(ZZTOT)=1:" SUMMARY",1:"")
+6 WRITE !,DIVDA(DIVDA)
+7 WRITE !,"FROM: ",PSXB," TO: ",$PIECE(PSXE,"@")," PRINTED: ",PSXNOW
+8 SET PSXLINE=6
+9 XECUTE LINE
AHEAD WRITE !,"DATE",?8,"TOTAL",?17,"ENTERED",?35,"OUTPATIENT",?47,"RELEASED",?65,"CMOP",?74,"OTHER"
+1 WRITE !,?8,"MAIL",?17,"WINDOW",?35,"MAIL",?47,"WINDOW",?65,"Released"
+2 WRITE !,?17,"Tot",?23,"Ref",?29,"Rn1",?47,"Tot",?53,"Ref",?59,"Rn1"
+3 XECUTE LINE
+4 QUIT
MAIN IF IOST["C-"
IF ($GET(PSXLINE)>20)
Begin DoDot:1
+1 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $GET(Y)'=1
SET PSXFLAG=1
KILL Y
QUIT
+2 DO TITLE
End DoDot:1
if $GET(PSXFLAG)=1
QUIT
+3 IF IOST'["C-"
IF ($GET(PSXLINE)>60)
WRITE @IOF
DO TITLE
+4 SET PSXUNREL=$GET(PSXUNREL)+$GET(PSXCU)
+5 SET ZDATE=$EXTRACT(PSXD,4,5)_"/"_$EXTRACT(PSXD,6,7)
+6 SET A=19-($LENGTH($GET(PSXWT))\2)
SET B=29-($LENGTH($GET(PSXM))\2)
SET C=40-($LENGTH($GET(PSXW))\2)
SET D=57-($LENGTH($GET(PSXCR))\2)
SET E=72-($LENGTH($GET(PSXUNREL))\2)
+7 ;W !,ZDATE,?10,$G(PSXMT),?A,$G(PSXWT),?B,$G(PSXM),?C,$G(PSXW),?D,$G(PSXCR),?E,$G(PSXUNREL)
+8 WRITE !,ZDATE,?8,+$GET(PSXMT),?17,+$GET(PSXWT),?23,+$GET(PSXWRF),?29,+$GET(PSXWRN),?35,+$GET(PSXM),?47,+$GET(PSXW),?53,+$GET(PSXRRF),?59,+$GET(PSXRRN),?65,+$GET(PSXCR),?74,+$GET(PSXUNREL)
+9 SET PSXD1=PSXD
SET PSXLINE=$GET(PSXLINE)+1
+10 SET TOTALT(DIVDA,"WINDOW REFIL")=$GET(TOTALT(DIVDA,"WINDOW REFIL"))+$GET(PSXWRF)
+11 SET TOTALT(DIVDA,"WINDOW RENEW")=$GET(TOTALT(DIVDA,"WINDOW RENEW"))+$GET(PSXWRN)
+12 SET TOTALT(DIVDA,"RELEASE REFIL")=$GET(TOTALT(DIVDA,"RELEASE REFIL"))+$GET(PSXRRF)
+13 SET TOTALT(DIVDA,"RELEASE RENEW")=$GET(TOTALT(DIVDA,"RELEASE RENEW"))+$GET(PSXRRN)
+14 KILL PSXMT,PSXWT,PSXCR,PSXCU,PSXM,PSXW,PSXCR,PSXUNREL,PSXWRF,PSXWRN,PSXRRF,PSXRRN
+15 QUIT
GTOTAL ;
+1 if $GET(PSXFLAG)=1
QUIT
+2 FOR X="MAIL","WINDOW","OP MAIL","OP WINDOW","CMOP RELEASED","CMOP UNRELEASED","OTHER"
SET TOTALT(DIVDA,X)=$GET(TOTAL(X))
+3 KILL TOTAL
+4 IF IOST["C-"
IF ($GET(PSXLINE)<20)
SET DIR(0)="E"
DO ^DIR
KILL DIR
if (Y="")
QUIT
+5 QUIT
GRNDTOT ;EP WRITE /LOOP DIVISIONAL TOTALS & WRITE GRAND TOTALS
+1 if $GET(PSXFLAG)=1
QUIT
+2 WRITE @IOF
+3 SET DIVDA(0)=" Grand Total Summary"
SET DIVDA=0
+4 DO TITLE
+5 SET LINE="W ! F I=1:1:80 W ""="""
+6 SET DIV=0
FOR
SET DIV=$ORDER(DIVDA(DIV))
if 'DIV
QUIT
Begin DoDot:1
+7 DO DIVSUM
+8 FOR X="MAIL","WINDOW","OP MAIL","OP WINDOW","CMOP RELEASED","CMOP UNRELEASED","OTHER","WINDOW RENEW","WINDOW REFIL","RELEASE REFIL","RELEASE RENEW"
SET TOTALT(0,X)=$GET(TOTALT(0,X))+$GET(TOTALT(DIV,X))
End DoDot:1
+9 XECUTE LINE
+10 SET DIV=0
DO DIVSUML
+11 QUIT
DIVSUM ;EP DIVISIONAL SUMMARY
+1 if $GET(PSXFLAG)=1
QUIT
+2 WRITE !,DIVDA(DIV)
DIVSUML ;
+1 if $GET(PSXFLAG)=1
QUIT
+2 WRITE !,?8,+$GET(TOTALT(DIV,"MAIL"))
+3 WRITE ?17,+$GET(TOTALT(DIV,"WINDOW"))
+4 WRITE ?23,+$GET(TOTALT(DIV,"WINDOW REFIL"))
+5 WRITE ?29,+$GET(TOTALT(DIV,"WINDOW RENEW"))
+6 WRITE ?35,+$GET(TOTALT(DIV,"OP MAIL"))
+7 WRITE ?47,+$GET(TOTALT(DIV,"OP WINDOW"))
+8 WRITE ?53,+$GET(TOTALT(DIV,"RELEASE REFIL"))
+9 WRITE ?59,+$GET(TOTALT(DIV,"RELEASE RENEW"))
+10 WRITE ?65,+$GET(TOTALT(DIV,"CMOP RELEASED"))
+11 WRITE ?74,+($GET(TOTALT(DIV,"CMOP UNRELEASED"))+$GET(TOTALT(DIV,"OTHER")))
+12 IF IOST["C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
if (Y="")
QUIT
+13 QUIT
SEL ;Select divisions
+1 ; returns arrays
+2 ; DIVNM("names of divisions")=selection number
+3 ; DIVDA("iens of divisions")=name of division
+4 ; for testing
+5 WRITE !!,"SELECTION OF DIVISION(S)",!
+6 SET DIV=""
KILL DIVNM,DIVDA,DIVX
+7 FOR I=1:1
SET DIV=$ORDER(^PS(59,"B",DIV))
if DIV=""
QUIT
SET DIVNM(I)=DIV
SET DIVNM(DIV)=I
SET DIVDA=$ORDER(^PS(59,"B",DIV,0))
SET DIVNM(I,"I")=DIVDA
+8 SET I=I-1
+9 KILL DIR
+10 SET DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
+11 DO ^DIR
KILL DIR
+12 if Y="A"
GOTO ALL
+13 if Y="S"
GOTO SELECT
+14 QUIT
SELECT ;
+1 FOR C=1:1:I
SET DIR("A",C)=C_" "_DIVNM(C)
+2 SET DIR(0)="LO^1:"_I
SET DIR("A")="Select Division(s) "
+3 DO ^DIR
+4 IF '+Y
KILL DIVNM
QUIT
+5 MERGE DIVX=DIVNM
KILL DIVNM
+6 FOR I=1:1
SET X=$PIECE(Y,",",I)
if 'X
QUIT
MERGE DIVNM(X)=DIVX(X)
SET DIVNM=DIVX(X)
SET DIVNM(DIVNM)=X
+7 KILL DIVX,DIR
ALL WRITE !!,"You have selected:",!
SET DIV=0
FOR
SET DIV=$ORDER(DIVNM(DIV))
if 'DIV
QUIT
WRITE !,DIV,?5,DIVNM(DIV)
+1 SET DIR(0)="Y"
SET DIR("A")="Is this corrrect ? "
SET DIR("B")="YES"
DO ^DIR
+2 KILL DIR
+3 IF Y
Begin DoDot:1
+4 KILL DIVDA
+5 SET DIV=0
FOR
SET DIV=$ORDER(DIVNM(DIV))
if 'DIV
QUIT
SET DA=DIVNM(DIV,"I")
SET DIVDA(DA)=DIVNM(DIV)
KILL DIVNM(DIV)
End DoDot:1
QUIT
+6 GOTO SEL
+7 ;
TOTALT ;
+1 SET X="TOTALT"
FOR
SET X=$QUERY(@X)
if X=""
QUIT
WRITE !,X,?30,@X
+2 QUIT
EXIT DO END
+1 KILL DIVDA,TOTAL,TOTALT,I,LINE,PSXRRF,PSXXB,PSXRNM,DIV
+2 QUIT
