- 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 Feb 18, 2025@23:11:22 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