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