source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXSUDCN.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1PSXSUDCN ;BIR/HTW-Routine to Provide Report of Rx's Suspended for CMOP ; 31 Oct 2000 1:20 PM
2 ;;2.0;CMOP;**31**;11 Apr 97
3 ; External reference to ^PS(52.5 supported by DBIA #1222
4 ; External reference to ^PS(59 supported by DBIA #1976
5 ;
6BEGDATE ;GET BEGIN DATE
7 K DIR
8 W !,"Rx's Suspended for CMOP",!
9 S DIR(0)="DO",DIR("A")="ENTER BEGINNING DATE " D ^DIR K DIR
10 G:($G(Y)="")!($D(DIRUT)) END1
11 S PSXB=Y
12ENDDATE ;GET ENDING DATE
13 K DIR,X,Y
14 S Y=DT X ^DD("DD") S DIR("B")=Y
15 S DIR(0)="DO",DIR("A")="ENTER ENDING DATE" D ^DIR K DIR
16 I $G(Y)="" G BEGDATE
17 Q:$D(DTOUT) I $D(DUOUT) G BEGDATE
18 S PSXE=Y
19 I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
20 ; select division(s)
21 D SEL
22 I '$D(DIVNM) D END1,EXIT Q
23 ;
24DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
25 D ^%ZIS G:POP END1 S PSXLAP=ION
26 I IOST["C-" G EN1
27 I '$D(IO("Q")) G EN0
28QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVDA(")="",ZTSAVE("DIVNM(")="",ZTIO=PSXLAP
29 S ZTRTN="EN1^PSXSUDCN"
30 S ZTDESC="CMOP Count of Suspended CMOP Rx's by Day"
31 D ^%ZTLOAD
32Q1 W:$D(ZTSK) !!,"Report Queued to Print!! ",ZTSK,!
33 K DIR,PSXB,PSXE,Y D ^%ZISC
34 D EXIT
35 Q
36EN0 U IO
37 ;Called by Taskman to run CMOP Rx's by day report
38EN1 ;
39 S:$D(ZTQUEUED) ZTREQ="@"
40DIVISION ;
41 S DIV=0 F Q:$G(PSXFLAG)=1 S DIV=$O(DIVDA(DIV)) Q:DIV'>0 D ONEDIV
42 D GRNDSUM
43 G EXIT
44 ;
45ONEDIV ;
46 S LINE="W ! F I=1:1:80 W ""=""",CT=0
47 S Y=PSXB X ^DD("DD") S PSXBE=Y
48 S Y=PSXE X ^DD("DD") S PSXEE=Y
49 S (PSXQ,PSXL,PSXAX,PSXP,PSXTOT)=0
50 S PSXD=PSXB-.00001,PSXTE=PSXE+.99999
51 D HEADER S CT=8
52 F Q:$G(PSXFLAG)=1 S PSXD=$O(^PS(52.5,"C",PSXD)) Q:'PSXD!(PSXD>PSXTE) D 525,BODY Q:$G(ANS)="^"
53 G END
54525 Q:$G(PSXFLAG)=1
55 F PSX525=0:0 Q:$G(PSXFLAG)=1 S PSX525=$O(^PS(52.5,"C",PSXD,PSX525)) Q:'PSX525 I $D(^PS(52.5,PSX525,0)) D
56 .S DIVRX=$P(^PS(52.5,PSX525,0),U,6) Q:DIVRX'=DIV
57 .S N=$P($G(^PS(52.5,PSX525,0)),"^",7) I N]"" D
58 ..S:N="Q" PSXQ=PSXQ+1
59 ..I N="L"!(N="X")!(N="R") S PSXAX=PSXAX+1
60 ..S:N="P" PSXP=PSXP+1
61 ..S PSXTOT=PSXTOT+1
62 Q
63HEADER D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
64HDR1 I IOST["C-" W @IOF
65 W !,?20,"COUNT OF SUSPENDED CMOP RX's BY DAY"
66 W !,DIVDA(DIV)
67 W !,"FROM: "_PSXBE," TO: "_$P(PSXEE,"@")," PRINTED: ",PSXNOW
68 X LINE
69H1 W !,"DATE",?14,"QUEUED",?29,"TRANSMITTED",?47,"PRINTED",?62,"TOTAL"
70 S A=15-($L($G(PSXQ))\2),B=35-($L($G(PSXAX))\2),C=49-($L($G(PSXP))\2),D=62-($L($G(PSXTOT))\2)
71 X LINE
72 Q
73BODY ;
74 Q:$G(PSXFLAG)=1
75 I IOST["C-",(CT>20) D PAGE Q:$G(ANS)="^" W @IOF S CT=0 D HDR1 G B1
76 I $G(CT)>56 S CT=0 W @IOF D HEADER
77B1 S Y=PSXD X ^DD("DD") S XDATE=$P(Y,","),CT=CT+1
78 W !,XDATE,?A,$J($G(PSXQ),5),?B,$J($G(PSXAX),5),?C,$J($G(PSXP),5),?D,$J($G(PSXTOT),5)
79 S PSXQGD=$G(PSXQGD)+PSXQ,PSXAXGD=$G(PSXAXGD)+PSXAX,PSXPGD=$G(PSXPGD)+PSXP,PSXTOTGD=$G(PSXTOTGD)+PSXTOT
80 S (PSXQ,PSXAX,PSXP,PSXTOT)=0 K XDATE
81 Q
82PAGE Q:$G(PSXFLAG)=1
83 K DIR S DIR(0)="FO",DIR("A")="Press RETURN to continue or ""^"" to exit" D ^DIR S:$D(DTOUT)!($D(DUOUT)) (ANS)="^",PSXFLAG=1
84 Q
85END Q:$G(PSXFLAG)=1
86 X LINE W !,"Division Total",?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
87 F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S DIVTOT(DIV,X)=$G(@X)
88 I IOST["C-" D PAGE
89 I IOST'["C-" W @IOF
90END1 K DIR,X,Y,%,PSXD,PSXF,PSXQ,PSXL,PSXP,PSXAX,PSXTOT,PSXUNREL
91 K PSXAD,PSXOT,PSXR,I,PSXZ,FILL,STAT,NODE,POP,PSXGO
92 K PSXLAP,PSXNOW,PSXYES,ZTDESC,ZTIO,ZTRTN,ZTSAVE,PSXMW,PSXM,PSXW
93 K A,B,D,E,PSXCR,PSXCU,PSXFILL,PSXSUSDT,PSXX,ZTSK
94 K N,PSX525,PSXMT,PSXWT,C,CT,DIRUT,DIROUT,DTOUT,DUOUT,J,ANS,PSXQGD,PSXAXGD,PSXPGD,PSXTOTGD
95 Q
96EXIT ;
97 D ^%ZISC
98 K PSXB,PSXE,LINE,PSXBE,PSXEE,PSXTE,DIVNM,DIVDA,DIV,DIVRX,DIVTOT,PSXFLAG D END1
99 Q
100SEL ;Select divisions
101 ; returns arrays
102 ; DIVNM("names of divisions")=selection number
103 ; DIVDA("iens of divisions")=name of division
104 ; for testing
105 W !!,"SELECTION OF DIVISION(S)",!
106 S DIV="" K DIVNM,DIVDA,DIVX
107 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
108 S I=I-1
109 K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
110 D ^DIR K DIR
111 G:Y="A" ALL
112 G:Y="S" SELECT
113 Q
114SELECT ;
115 F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
116 S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
117 D ^DIR
118 I '+Y K DIVNM Q
119 M DIVX=DIVNM K DIVNM
120 F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
121 K DIVX,DIR
122ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
123 S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
124 K DIR
125 I Y D Q
126 .K DIVDA
127 .S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
128 G SEL
129 ;
130GRNDSUM ;
131 Q:$G(PSXFLAG)=1
132 S DIV=0,DIVDA(0)=" GRAND TOTAL SUMMARY"
133 D HEADER
134 K DIVTOT(0)
135 F S DIV=$O(DIVDA(DIV)) Q:DIV'>0 D
136 . W !,DIVDA(DIV)
137 . F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S @X=DIVTOT(DIV,X),DIVTOT(0,X)=$G(DIVTOT(0,X))+@X
138 . W !,?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
139 F X="PSXQGD","PSXAXGD","PSXPGD","PSXTOTGD" S @X=DIVTOT(0,X)
140 X LINE
141 W !,"Grand Total",?A,$J($G(PSXQGD),5),?B,$J($G(PSXAXGD),5),?C,$J($G(PSXPGD),5),?D,$J($G(PSXTOTGD),5)
142 Q
Note: See TracBrowser for help on using the repository browser.