Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXRSTAT

PSXRSTAT.m

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