source: FOIAVistA/tag/r/CMOP-PSX/PSXRACT.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.4 KB
Line 
1PSXRACT ;BIR/HW-ACTIVITY REPORT [ 05/10/97 2:28 PM ] ; 31 Oct 2000 2:28 PM
2 ;;2.0;CMOP;**1,31**;11 Apr 97
3 ; External reference to ^PSRX( supported by DBIA #1221
4 ; External reference to ^PS(59 supported by DBIA #1976
5 ;
6BEGDATE S DIR(0)="DO",DIR("A")="ENTER BEGINNING TRANSMISSION DATE " D ^DIR K DIR
7 G:$D(DIRUT)!(X']"") END
8 S PSXB=Y K Y,X
9 I PSXB>DT W !!,"Future dates are not allowed.",! G BEGDATE
10ENDDATE S Y=DT X ^DD("DD") S ZZTODAY=Y K Y
11 K X,Y
12 S DIR(0)="DO",DIR("A")="ENTER ENDING TRANSMISSION DATE ",DIR("B")=ZZTODAY
13 D ^DIR K DIR
14 G:$D(DIRUT) END
15 S PSXE=Y K Y
16 I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
17 K ZZTODAY
18 D SEL Q:'$D(DIVNM)
19DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
20 D ^%ZIS G:POP END S PSXLAP=ION
21 I $E(IOST,1,2)["C-" G START
22 I '$D(IO("Q")) G ST0
23 D ^%ZISC K J,C
24QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVNM(")="",ZTSAVE("DIVDA(")="",ZTIO=PSXLAP
25 S ZTRTN="START^PSXRACT"
26 S ZTDESC="CMOP Activity Report"
27 D ^%ZTLOAD
28Q1 W:$D(ZTSK) !!,"Report Queued to Print!!"
29 K DIR,PSXB,PSXE,Y
30 Q
31ST0 U IO
32 ;Called by taskman to print the CMOP Activity Report
33START S:$D(ZTQUEUED) ZTREQ="@"
34 S LINE="W ! F I=1:1:80 W ""="""
35DIVISION ;
36 S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:DIVDA'>0 D ONEDIV
37 D GRNDSUM
38 G EXIT
39 ;
40 Q
41ONEDIV ;
42 S LINE="W ! F I=1:1:80 W ""=""",CT=0
43 S Y=PSXB X ^DD("DD") S PSXBE=Y
44 S Y=PSXE X ^DD("DD") S PSXEE=Y
45 S PSXE1=PSXE+.99999,PSXD=PSXB-.00001
46 D TITLE
47BATCH F S PSXD=$O(^PSX(550.2,"D",PSXD)) Q:(+PSXD'>0)!(+PSXD>PSXE1) D Q:$G(PSXFLAG)=1
48 .F P5502=0:0 S P5502=$O(^PSX(550.2,"D",PSXD,P5502)) Q:'P5502 D Q:$G(PSXFLAG)=1
49 ..S BATCH=+$P($G(^PSX(550.2,P5502,0)),"^") Q:$G(BATCH)']""
50 ..S DIV=$P($G(^PSX(550.2,P5502,0)),"^",3),DIV=$P($G(^PS(59,DIV,0)),"^")
51 ..I '$D(DIVNM(DIV)) Q
52 ..I DIV'=DIVDA(DIVDA) Q
53 ..S NODE=$G(^PSX(550.2,P5502,1)) Q:$G(NODE)']""
54 ..S ORDS=$P($G(NODE),"^",7),TORDS=$G(TORDS)+ORDS,RTRN=$P(NODE,"^",2)
55 ..S TORDS(DIV)=$G(TORDS(DIV))+ORDS
56 ..S RXS=$P($G(NODE),"^",8),TRXS=$G(TRXS)+RXS
57 ..S TRXS(DIV)=$G(TRXS(DIV))+RXS
58 ..F PSXR=0:0 S PSXR=$O(^PSRX("AS",PSXD,PSXR)) Q:'PSXR D
59 ...S PSXF="" F S PSXF=$O(^PSRX("AS",PSXD,PSXR,PSXF)) Q:($G(PSXF)']"") D RX
60 ..D PRINT Q:$G(PSXFLAG)=1
61 X LINE
62 S DIV=DIVDA(DIVDA)
63 W !,?9,DIV,?35,$J($G(TORDS(DIV)),7),?43,$J($G(TRXS(DIV)),6),?53,$J($G(PSXCRT(DIV)),7),?63,$J($G(PSXNDT(DIV)),7),?73,$J($G(PSXCUT(DIV)),5)
64 Q
65GRNDSUM ;
66 S DIVDA(0)=" Grand Total Summary",DIVDA=0
67 D TITLE
68 S DIV=0 F S DIV=$O(TORDS(DIV)) Q:DIV="" D
69 .W !,?9,DIV,?35,$J($G(TORDS(DIV)),7),?43,$J($G(TRXS(DIV)),6),?53,$J($G(PSXCRT(DIV)),7),?63,$J($G(PSXNDT(DIV)),7),?73,$J($G(PSXCUT(DIV)),5)
70 X LINE
71 W !!,"TOTAL",?35,$J($G(TORDS),7),?43,$J($G(TRXS),6),?53,$J($G(PSXCRT),7),?63,$J($G(PSXNDT),7),?73,$J($G(PSXCUT),5)
72END K DIR,DIRUT,PSXB,PSXE,ZZTODAY,PSXLAP,PSXE1,PSXOT,PSXD,P5502,BATCH
73 K DIV,NODE,TORDS,TRXS,PSXR,PSXF,GT,PSXFLAG,ZNODE,ZFILL,PSXSTAT,PSXCR
74 K PSX,PSXCRT,PSXCUT,PSXLINE,PSXNDT,PSXNOW,X,Y,%,RTRN
75 Q
76EXIT ;
77 D END
78 K DIVDA,DIVNM,PSXB,PSXE,LINE,CT,I,PSXBE,PSXEE,ZZTOT,ZTSK
79 D ^%ZISC
80 Q
81RX ; COUNT RX DATA
82 I $D(^PSRX(PSXR,4,0)) F PSX=0:0 S PSX=$O(^PSRX(PSXR,4,PSX)) Q:'PSX D
83 .S ZNODE=$G(^PSRX(PSXR,4,PSX,0)),ZFILL=$P($G(ZNODE),"^",3)
84 .I $G(ZFILL)'=PSXF K ZFILL Q
85 .I +$G(ZNODE)'=BATCH Q
86 .S PSXSTAT=$P($G(ZNODE),"^",4),PSX(ZFILL)=PSXSTAT
87 .K ZNODE,ZFILL,PSXSTAT
88 I $G(PSX(PSXF))=1 S PSXCR=$G(PSXCR)+1,PSXCRT=$G(PSXCRT)+1 D Q
89 .S PSXCRT(DIV)=$G(PSXCRT(DIV))+1
90 I $G(PSX(PSXF))=3 S PSXND=$G(PSXND)+1,PSXNDT=$G(PSXNDT)+1 D Q
91 .S PSXNDT(DIV)=$G(PSXNDT(DIV))+1
92 I $G(PSX(PSXF))=2 S PSXRT=$G(PSXRT)+1 S:(RTRN)>0 COM="FILLED IN "_$G(RTRN)
93 S PSXCU=$G(PSXCU)+1,PSXCUT=$G(PSXCUT)+1
94 S PSXCUT(DIV)=$G(PSXCUT(DIV))+1
95 S:$G(COM)'="" PSXCU=""
96 Q
97TITLE I IOST["C-" W @IOF
98 S Y=PSXB X ^DD("DD") S PSXBP=Y
99 S Y=PSXE X ^DD("DD") S PSXEP=Y
100 D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
101 W !,?30,"CMOP ACTIVITY REPORT"_$S($G(ZZTOT)=1:" SUMMARY",1:"")
102 W !,DIVDA(DIVDA)
103 W !,"For ",PSXBP," thru ",$P(PSXEP,"@"),?40,"Printed: ",PSXNOW
104 S PSXLINE=6
105 K PSXBP,PSXEP
106 X LINE
107AHEAD W !,"TRANS #",?9,"DIVISION",?37,"ORDERS",?45,"RXS",?53,"RELEASED",?63,"NOT DISP",?73,"UNREL"
108 X LINE
109 Q
110PRINT I IOST["C-",($G(PSXLINE)>20) D Q:$G(PSXFLAG)=1
111 .S DIR(0)="E" D ^DIR K DIR I $G(Y)'=1 S PSXFLAG=1 K Y Q
112 .D TITLE
113 I IOST'["C-",($G(PSXLINE)>60) W @IOF D TITLE
114 ;S:$G(COM)="" PSXCU=""
115 W !,$J($G(BATCH),6),?9,$S($G(COM)'="":$E($G(DIV),1,10)_" "_$G(COM),1:$G(DIV)),?35,$J($G(ORDS),7),?43,$J($G(RXS),6),?53,$J($G(PSXCR),7),?63,$J($G(PSXND),7),?73,$J($G(PSXCU),5)
116 S PSXLINE=$G(PSXLINE)+1
117 K BATCH,DIV,ORDS,RXS,PSXCR,PSXND,PSXCU,PSXRT,COM,COM1
118 Q
119SEL ;Select divisions
120 ; returns arrays
121 ; DIVNM("names of divisions")=selection number
122 ; DIVDA("iens of divisions")=name of division
123 ; for testing
124 W !!,"SELECTION OF DIVISION(S)",!
125 S DIV="" K DIVNM,DIVDA,DIVX
126 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
127 S I=I-1
128 K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
129 D ^DIR K DIR G:Y="A" ALL
130 G:Y="S" SELECT
131 Q
132SELECT ;
133 F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
134 S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
135 D ^DIR
136 I '+Y K DIVNM Q
137 M DIVX=DIVNM K DIVNM
138 F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
139 K DIVX,DIR
140ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
141 S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
142 K DIR
143 I Y D Q
144 .K DIVDA
145 .S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
146 G SEL
147 ;
Note: See TracBrowser for help on using the repository browser.