source: FOIAVistA/tag/r/CMOP-PSX/PSXRSTAT.m@ 1005

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