source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/AWCMCPR1.m@ 710

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1AWCMCPR1 ;VISN 7/THM-CPRS MONITOR ;Feb 27, 2004
2 ;;7.3;TOOLKIT;**84,86**;Jan 09, 2004
3 ;
4 W !!,$C(7),"You cannot run this program directly.",!,"Application use only !!",!! H 2 Q ;enter properly
5 ;
6STRT1 ; tiu
7 N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
8 I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
9 I $P(AWCDTA,U,2)'=1 G ENDQ ;tiu
10 S AWCTYPE=1,AWCSTRT=$H
11 Q
12 ;
13STRT2 ; lab
14 N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
15 I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
16 I $P(AWCDTA,U,3)'=1 G ENDQ ;lab
17 S AWCTYPE=2,AWCSTRT=$H
18 Q
19 ;
20STRT3 ; reminders
21 N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
22 I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
23 I $P(AWCDTA,U,4)'=1 G ENDQ ;reminders
24 S AWCTYPE=3,AWCSTRT=$H
25 K AWCDTA
26 Q
27 ;
28END ; record the data
29 ; quit if turning on/back on in middle of transaction (AWCTYPE or AWCSTRT missing)
30 I '$D(AWCTYPE)!('$D(AWCSTRT)) G ENDQ
31 S AWCDTA=$G(^AWC(177100.12,1,0))
32 I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
33 I $P(AWCDTA,U,2)'=1 G ENDQ ;tiu
34 I $P(AWCDTA,U,3)'=1 G ENDQ ;lab
35 I $P(AWCDTA,U,4)'=1 G ENDQ ;reminder
36 S AWCEND=$H
37 L +^XTMP("AWCCPRS",.5):1 G:'$T ENDQ
38 S AWCDA=+$G(^XTMP("AWCCPRS",.5))
39 I AWCDA>50000000 S AWCDA=0 ; reset to zero at fifty million entries
40 S AWCDA=AWCDA+1,^XTMP("AWCCPRS",.5)=AWCDA
41 L -^XTMP("AWCCPRS",.5)
42 S AWCFMDT=$$HTFM^XLFDT(AWCSTRT)
43 S ^XTMP("AWCCPRS",AWCFMDT,AWCDA,0)=AWCSTRT_U_AWCEND_U_DUZ_U_(+$G(DUZ(2)))_U_AWCTYPE
44 ;
45ENDQ K AWCDTA,AWCSEC,AWCFMDT,AWCTYPE,AWCSTRT,AWCEND,DO,DD,DIC,DIE,AWCDA
46 Q
47 ;
48PPAGE ; entry point to create updated .htm file
49 ; possible values for AWCX are VMS, VMSC, or NT
50 S AWCX="",AWCOS=$P(^%ZOSF("OS"),U)
51 I AWCOS["VAX DSM" S AWCX="VMS"
52 I AWCOS["OpenM-VMS" S AWCX="VMSC"
53 I AWCOS["OpenM" S AWCX="VMSC"
54 ; To double check for OS
55 I $T(OS^%ZOSV)'="" D
56 . I $$OS^%ZOSV()="VMS" S AWCX="VMSC"
57 . I $$OS^%ZOSV()="NT" S AWCX="NT"
58 ;
59 K TMP("AWC") D DT^DICRW
60 Q:'$D(^AWC(177100.12,1,0)) ;param file not set up
61 ; extract the parameters
62 S AWCDTA=$G(^AWC(177100.12,1,0))
63 S AWCDTA1=$G(^AWC(177100.12,1,1))
64 S AWCDHRS=$P(AWCDTA,U,7) I AWCDHRS="" S AWCDHRS=8 ;# hours to display
65 S X=$P(AWCDTA,U,8) S AWCMXSEC=$S(X]"":X,1:30) ;number of seconds to display
66 S X=$P(AWCDTA,U,9) S AWCTIULN=$S(X]"":X,1:"192,0,0") ;rgb code tiu line
67 S X=$P(AWCDTA,U,10) S AWCLABLN=$S(X]"":X,1:"0,192,0") ;rgb code lab line
68 S X=$P(AWCDTA,U,11) S AWCREMLN=$S(X]"":X,1:"0,0,192") ;rgb code reminder line
69 S X=$P(AWCDTA,U,12) S AWCGRDON=$S(X="y":"true",X="n":"false",1:"true")
70 S X=$P(AWCDTA,U,13) S AWCBKGRN=$S(X]"":X,1:"230,230,230") ;rgb code
71 S X=$P(AWCDTA1,U,3) S AWCMSRV=$S(X]"":X,1:"") ;server
72 S X=$P(AWCDTA1,U,4) S AWCMUSR=$S(X]"":X,1:"") ;user
73 S X=$P(AWCDTA1,U,5) S AWCMPW=$S(X]"":X,1:"") ;passwd
74 ;
75 K AWCDTA D NOW^%DTC S (AWCENDDT,AWCCURTM)=%,AWCTSEC=3600*AWCDHRS
76 S AWCI1=$P(%H,",",1),AWCI2=$P(%H,",",2)
77 S AWCI2=(AWCI2-AWCTSEC) I AWCI2<0 S AWCI2=AWCI2+86400,AWCI1=AWCI1-1
78 S %H=AWCI1_","_AWCI2 D YMD^%DTC S AWCBEGDT=X_%
79 S X=$E(%,2,4),X=X_"0",X=$S($L(X)<4:X_"0",1:X) ;format to four digits, including any leading zeros
80 S AWCBEGTM=+X
81 S X=$P(AWCCURTM,".",2),X=($E(X,1,3)_"0"),X=$S($L(X)<4:X_"0",1:X) ;format to four digits as above
82 S AWCENDTM=+X K ^TMP("AWCTTIM",$J)
83 ; This loop skips 60 due to adding 10 to starting number. These two lines
84 ; cause it to print 0-50 min, skipping 60, like this: 210 220,230,240,250,300
85 I AWCBEGTM>AWCENDTM F X=AWCBEGTM:10:2350 S ^TMP("AWCTTIM",$J,(-9999+X))="" S:$E(X,($L(X)-1),$L(X))=50 X=X+40 S:X=2360 X="0" ;before midnight
86 I AWCBEGTM>AWCENDTM F X=0:10:AWCENDTM S ^TMP("AWCTTIM",$J,X)="" S:$E(X,($L(X)-1),$L(X))=50 X=X+40 ;after midnight
87 I AWCENDTM>AWCBEGTM F X=AWCBEGTM:10:AWCENDTM S ^TMP("AWCTTIM",$J,X)="" I $E(X,($L(X)-1),($L(X)))=50 S X=X+40 ;normal times
88 ;
89SORT ; sort the data into a TMP file
90 K ^TMP($J)
91 F AWCSRTDT=(AWCBEGDT-.000001):0 S AWCSRTDT=$O(^XTMP("AWCCPRS",AWCSRTDT)) Q:AWCSRTDT=""!(AWCSRTDT>AWCENDDT) DO
92 .F DA=0:0 S DA=$O(^XTMP("AWCCPRS",AWCSRTDT,DA)) Q:DA="" DO
93 ..S AWCDTA=$G(^XTMP("AWCCPRS",AWCSRTDT,DA,0)),AWCDIV=$P(AWCDTA,U,4),AWCTYPE=$P(AWCDTA,U,5)
94 ..I AWCDIV="" S AWCDIV=+$$SITE^VASITE ;for people without division assignments
95 ..S ^TMP($J,AWCDIV,AWCTYPE,AWCSRTDT,DA)=""
96 ;
97DIVS ; count the divisions for drop-down box on web page (used in AWCMCPR2)
98 I '$D(^TMP($J)) D NODATA G PPAGE ;no data yet for time frame being processed
99 S AWCDCNTR=0
100 F AWCDIV=0:0 S AWCDIV=$O(^TMP($J,AWCDIV)) Q:AWCDIV="" DO
101 .S AWCFDIV(AWCDIV)=$P(^DIC(4,AWCDIV,0),U)_U_$P($G(^DIC(4,+AWCDIV,99)),U)_U
102 .S AWCDCNTR=AWCDCNTR+1
103 ; if only one division no drop-down box is needed
104 I AWCDCNTR=1 K AWCFDIV
105 ; generate one HTML page per facility
106DIVPG F AWCDIV=0:0 S AWCDIV=$O(^TMP($J,AWCDIV)) Q:AWCDIV="" DO G:POP EXIT
107 .S AWCDEV=$P($G(^AWC(177100.12,1,0)),U,5) I AWCDEV="" S POP=1 Q ;no HFS device in param file
108 .S (AWCDIVNM,AWCDIVN1)=$P(^DIC(4,AWCDIV,0),U)
109 .S AWCDIVNM=$P($G(^DIC(4,+AWCDIV,99)),U) Q:AWCDIVNM=""
110 .S AWCFILE=$P(^AWC(177100.12,1,0),U,6)_"_"_AWCDIVNM_".htm" ;web page name with division number
111 .Q:AWCFILE=("_"_AWCDIV)!(AWCDEV="") ;webpage or device is missing in parameter file
112 .; Check VMS or NT before you put the \ in the file name
113 .I AWCX="NT" D
114 ..S AWCZ=$L(AWCDEV) I $E(AWCDEV,AWCZ,AWCZ)'="\" S AWCDEV=AWCDEV_"\" ;add \ if missing
115 .D OPEN^%ZISH("AWCCPR1",AWCDEV,AWCFILE,"W") Q:POP
116 .S AWCHFIL1=AWCDEV_AWCFILE ;needed for AWCMFTP at end
117 .U IO D PART1^AWCMCPR2 ;part 1 of web page
118 .;
119TMPALL .; make the TMP("AWC", array with all possible hours, increments of ten, for all types 1,2,3, with zero values
120 .F T=1:1:3 F X=-99999:0 S X=$O(^TMP("AWCTTIM",$J,X)) Q:X="" S TMP("AWC",T,X)="0^0"
121 .;
122DVALS .; count the number of data values to display on graph
123 .S AWCVCNTR=0 F X=0:0 S X=$O(TMP("AWC",X)) Q:X="" F Y=0:0 S Y=$O(TMP("AWC",X,Y)) Q:Y="" S AWCVCNTR=AWCVCNTR+1
124 .S AWCVCNTR=AWCVCNTR/3 ;divide by 3 graph lines
125 .; get the data by date range provided and sort the data
126 .F AWCTYPE=0:0 S AWCTYPE=$O(^TMP($J,AWCDIV,AWCTYPE)) Q:AWCTYPE="" DO
127 ..F AWCDATE=(AWCBEGDT-.000001):0 S AWCDATE=$O(^TMP($J,AWCDIV,AWCTYPE,AWCDATE)) Q:AWCDATE=""!(AWCDATE>AWCENDDT) DO
128 ...F DA=0:0 S DA=$O(^TMP($J,AWCDIV,AWCTYPE,AWCDATE,DA)) Q:DA="" DO
129 ....S AWCDTA=$G(^XTMP("AWCCPRS",AWCDATE,DA,0)),AWCXSTRT=$P(AWCDTA,U),AWCXEND=$P(AWCDTA,U,2)
130 ....S AWCSEC=$$HDIFF^XLFDT(AWCXEND,AWCXSTRT,2)
131 ....S Y=AWCDATE X ^DD("DD") S X=$P(Y,"@",2),X=$TR(X,":","")
132 ....; sort the times ; AWCX1 is the hours ;AWCX3 is the minutes
133 ....; use 10-minute intervals and put with interval
134 ....S AWCX1=$E(X,1,2),AWCX3=$E(X,3,4) ;strip hours and minutes, no seconds although they are there
135 ....I "^00^01^02^03^04^05^"[(U_AWCX3_U) S AWCX3="00"
136 ....I "^06^07^08^09^10^11^12^13^14^15^"[(U_AWCX3_U) S AWCX3="10"
137 ....I "^16^17^18^19^20^21^22^23^24^25^"[(U_AWCX3_U) S AWCX3="20"
138 ....I "^26^27^28^29^30^31^32^33^34^35^"[(U_AWCX3_U) S AWCX3="30"
139 ....I "^36^37^38^39^40^41^42^43^44^45^"[(U_AWCX3_U) S AWCX3="40"
140 ....I "^46^47^48^49^50^51^52^53^54^55^"[(U_AWCX3_U) S AWCX3="50"
141 ....I "^56^57^58^59^"[(U_AWCX3_U) S AWCX3="60"
142 ....I AWCX3=60 S AWCX3="00",AWCX1=AWCX1+1
143 ....I AWCX1=24 S AWCX1="00"
144 ....S AWCTIME=+(AWCX1_AWCX3)
145 ....;
146SETTMP ....; set in TMP("AWC", array ONLY if within our selected range
147 ....I $D(TMP("AWC",AWCTYPE,(-9999+AWCTIME))) DO
148 .....S $P(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME))),U)=$P($G(TMP("AWC",AWCTYPE,-9999+(+AWCTIME))),U)+AWCSEC
149 .....S $P(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME))),U,2)=$P($G(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME)))),U,2)+1
150 ....I $D(TMP("AWC",AWCTYPE,+AWCTIME)) DO
151 .....S $P(TMP("AWC",AWCTYPE,+AWCTIME),U)=$P($G(TMP("AWC",AWCTYPE,+AWCTIME)),U)+AWCSEC
152 .....S $P(TMP("AWC",AWCTYPE,+AWCTIME),U,2)=$P($G(TMP("AWC",AWCTYPE,+AWCTIME)),U,2)+1
153 .;
154PART2 .D PART2^AWCMCPR2 ;part II of the HTML code
155 .; ftp the file
156 .D EN^AWCMFTP
157 I AWCX="NT" S CMD="S AWCVAR=$ZF(-1,"_"""erase ftpawc.txt"_""""_")" X CMD
158 I AWCX="VMS"!(AWCX="VMSC") D PURDEL^AWCMFTP
159 ;
160EXIT D ^%ZISC
161 K %,%H,AWCC,AWCAVG,AWCCNT,AWCDATE,AWCDEV,AWCDHRS,AWCDIV,AWCDT,AWCDTA,AWCEND,AWCFILE,AWCFMDT,AWCSEC,AWCY,AWCX
162 K AWCSTRT,AWCTIME,AWCTYPE,AWCZ,AWCBEGTM,DA,DD,DIC,DIE,DO,DR,AWCENDDT,AWCENDTM,AWCLBCNT,AWCPARAM,AWCPCNTR,AWCFDIVN
163 K POP,AWCTTIM,AWCVCNTR,X,AWCX1,AWCX3,Y,AWCBEGDT,AWCCURTM,AWCI1,AWCI2,T,AWCTSEC,Z,AWCDIVNM,AWCWL,AWCDVDTA
164 K AWCTIULN,AWCLABLN,AWCREMLN,AWCMXSEC,AWCGRDON,AWCBKGRN,AWCDIVN1,AWCFDIV,AWCDVNM,AWCDVNB,AWCWEBRT,AWCDCNTR,AWCFXDTA
165 K AWCOS,AWCDTA1,AWCHFIL1,AWCMPW,AWCMSRV,AWCMUSR,AWCMCP,AWCSITE,AWCSITEN,AWCVMSP,AWCOS,AWCSRTDT,AWCXDIV,YYY
166 K %I,%ZISHO,%ZISUB,%ZISHF,AWCWBFLD,CMD,AWC,AWCDIR,AWCDIRL,AWCHFILE,AWCHFILL,AWCOS,AWCVAR,Y,%SUBMIT,VMSC,AWCXDA
167 K ^TMP("AWCTTIM",$J),^TMP($J),TMP("AWC"),AWCXSTRT,AWCXEND,XDUZ,TMP
168 Q
169 ;
170NODATA ; handle no data for the day-create a zero, dummy record for the home facility.
171 ; this only occurs when a page is due to be run but no activity yet.
172 S (AWCSTRT,AWCEND)=$H
173 S AWCXDIV=$P($G(^AWC(177100.12,1,1)),U,2),AWCXDA=$O(^DIC(4,"D",AWCXDIV,0)) Q:AWCXDA=""
174 S AWCXDIV=$P($G(^DIC(4,AWCXDA,99)),U) Q:AWCXDIV=""
175 S XDUZ=.5,XDUZ(2)=AWCXDIV,AWCTYPE=1
176 L +^XTMP("AWCCPRS",.5):1 Q:'$T
177 S AWCDA=+$G(^XTMP("AWCCPRS",.5)),AWCDA=AWCDA+1,^XTMP("AWCCPRS",.5)=AWCDA
178 L -^XTMP("AWCCPRS",.5)
179 S AWCFMDT=$$HTFM^XLFDT(AWCSTRT)
180 S ^XTMP("AWCCPRS",AWCFMDT,AWCDA,0)=AWCSTRT_U_AWCEND_U_XDUZ_U_(+$G(XDUZ(2)))_U_AWCTYPE
181 Q
Note: See TracBrowser for help on using the repository browser.