source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/AWCMCPR3.m@ 789

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

initial load of WorldVistAEHR
File size: 5.7 KB
RevLine 
[613]1AWCMCPR3 ;VISN 7/THM-CPRS MONITOR - ROLLUP TO NATIONAL SERVER ;Feb 27, 2004
2 ;;7.3;TOOLKIT;**84,86**;Jan 09, 2004
3 ;
4 Q ;enter properly
5 ;
6GENSTAT ;; possible values for AWCX are VMS, VMSC, or NT
7 N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
8 I $P(AWCDTA,U,17)'="1" G EXIT ;master switch
9 S AWCX="",AWCOS=$P(^%ZOSF("OS"),U)
10 I AWCOS["VAX DSM" S AWCX="VMS"
11 I AWCOS["OpenM-VMS" S AWCX="VMSC"
12 I AWCOS["OpenM" S AWCX="VMSC"
13 ; VMS FOR CACHE MODS TO DOUBLE CHECK FOR OS
14 I $T(OS^%ZOSV)'="" D
15 . I $$OS^%ZOSV()="VMS" S AWCX="VMSC"
16 . I $$OS^%ZOSV()="NT" S AWCX="NT"
17 ;
18 Q:'$D(^AWC(177100.12,1,0)) ;no parameter file set up
19 K ^TMP("AWC",$J),^TMP("AWCTTIM",$J) D DT^DICRW
20 I '$D(AWCMANL) S X="T-1",%DT="" D ^%DT S AWCBEGDT=Y
21 S AWCENDDT=AWCBEGDT+.2359
22 S AWCBEGD1=17000000+AWCBEGDT ;yyyymmdd
23 S AWCTTIM="",AWCBEGTM=0,AWCENDTM=2400
24 ;This loop skips 60 due to adding 10 to starting number. These two lines
25 ;cause it to print 0-50 min, skipping 60, like this: 210 220,230,240,250,300
26 F X=0:10:AWCENDTM S ^TMP("AWCTTIM",$J,X)="" S:$E(X,($L(X)-1),$L(X))=50 X=X+40 ;previous day
27 ;make the ^TMP("AWC",$J, array with all possible hours, increments of ten for all types 1,2,3, with zero values
28 S AWCCNTR=0 F T=1:1:3 F X=-1:0 S X=$O(^TMP("AWCTTIM",$J,X)) Q:X="" S ^TMP("AWC",$J,T,X)="0^0"
29 S AWCDEV=$P($G(^AWC(177100.12,1,0)),U,5)
30 S AWCDIVNM=$P($G(^AWC(177100.12,1,1)),U,2) ;facility number
31 S AWCDIVN1=$P($G(^DIC(4,AWCDIVNM,0)),U) Q:AWCDIVN1="" ;division name
32 S AWCFILE="CPRSstats_"_AWCBEGD1_"_"_AWCDIVNM_".txt" ;text file division number
33 Q:AWCFILE=("_"_AWCDIVNM)!(AWCDEV="") ;webpage or device is missing in parameter file
34 ; CHECK VMS OR NT BEFORE YOU PUT THE \ IN FILE NAME
35 I AWCX="NT" D
36 .S AWCZ=$L(AWCDEV) I $E(AWCDEV,AWCZ,AWCZ)'="\" S AWCDEV=AWCDEV_"\" ;add \ if missing
37 ;
38 D OPEN^%ZISH("AWCMCPR3",AWCDEV,AWCFILE,"W") Q:$G(POP)=1
39 S AWCHFIL1=AWCDEV_AWCFILE ;needed for AWCMFTP at end
40 U IO
41DVALS ;get the data values
42 S AWCDATE=(AWCBEGDT-.000001)
43 F S AWCDATE=$O(^AWC(177100.13,"C",AWCDATE)) Q:AWCDATE=""!(AWCDATE>AWCENDDT) DO G:$G(POP)=1 EXIT
44 .F DA=0:0 S DA=$O(^AWC(177100.13,"C",AWCDATE,DA)) Q:DA="" DO
45 ..S AWCDTA=^AWC(177100.13,DA,0),AWCSEC=$P(AWCDTA,U,2),AWCTYPE=$P(AWCDTA,U,6)
46 ..S Y=AWCDATE X ^DD("DD") S X=$P(Y,"@",2),X=$TR(X,":","")
47 ..;sort the times ; AWCX1 is the hours ;AWCX3 is the minutes ;use 10-minute intervals
48 ..S AWCX1=$E(X,1,2),AWCX3=$E(X,3,99)
49 ..I "^00^01^02^03^04^05^"[(U_AWCX3_U) S AWCX3="00"
50 ..I "^06^07^08^09^10^11^12^13^14^15^"[(U_AWCX3_U) S AWCX3="10"
51 ..I "^16^17^18^19^20^21^22^23^24^25^"[(U_AWCX3_U) S AWCX3="20"
52 ..I "^26^27^28^29^30^31^32^33^34^35^"[(U_AWCX3_U) S AWCX3="30"
53 ..I "^36^37^38^39^40^41^42^43^44^45^"[(U_AWCX3_U) S AWCX3="40"
54 ..I "^46^47^48^49^50^51^52^53^54^55^"[(U_AWCX3_U) S AWCX3="50"
55 ..I "^56^57^58^59^"[(U_AWCX3_U) S AWCX3="60"
56 ..I AWCX3=60 S AWCX3="00",AWCX1=AWCX1+1
57 ..I AWCX1=24 S AWCX1="00"
58 ..S AWCTIME=+(AWCX1_AWCX3)
59 ..;
60SETTMP ..I $D(^TMP("AWC",$J,AWCTYPE,(-9999+AWCTIME))) DO
61 ...S $P(^TMP("AWC",$J,AWCTYPE,(-9999+(+AWCTIME))),U)=$P($G(^TMP("AWC",$J,AWCTYPE,-9999+(+AWCTIME))),U)+AWCSEC
62 ...S $P(^TMP("AWC",$J,AWCTYPE,(-9999+(+AWCTIME))),U,2)=$P($G(^TMP("AWC",$J,AWCTYPE,(-9999+(+AWCTIME)))),U,2)+1
63 ..I $D(^TMP("AWC",$J,AWCTYPE,+AWCTIME)) DO
64 ...S $P(^TMP("AWC",$J,AWCTYPE,+AWCTIME),U)=$P($G(^TMP("AWC",$J,AWCTYPE,+AWCTIME)),U)+AWCSEC
65 ...S $P(^TMP("AWC",$J,AWCTYPE,+AWCTIME),U,2)=$P($G(^TMP("AWC",$J,AWCTYPE,+AWCTIME)),U,2)+1
66 K AWCTOTX
67 F AWCTYPE=0:0 S AWCTYPE=$O(^TMP("AWC",$J,AWCTYPE)) Q:AWCTYPE="" S AWCPCNTR=0 F AWCTIME=-9999:0 S AWCTIME=$O(^TMP("AWC",$J,AWCTYPE,AWCTIME)) Q:AWCTIME="" DO
68 .S AWCDTA=$G(^TMP("AWC",$J,AWCTYPE,AWCTIME)),AWCSEC=$P(AWCDTA,U),AWCCNT=$P(AWCDTA,U,2)
69 .I $L(AWCTIME)=1 S AWCTIME="000"_AWCTIME
70 .I $L(AWCTIME)=2 S AWCTIME="00"_AWCTIME
71 .I $L(AWCTIME)=3 S AWCTIME="0"_AWCTIME
72 .I +AWCTIME<759 S $P(AWCTOTX(AWCTYPE,1),U,1)=$P($G(AWCTOTX(AWCTYPE,1)),U,1)+AWCSEC DO Q
73 ..S $P(AWCTOTX(AWCTYPE,1),U,2)=$P(AWCTOTX(AWCTYPE,1),U,2)+AWCCNT
74 .I +AWCTIME>759&(+AWCTIME<1600) S $P(AWCTOTX(AWCTYPE,2),U,1)=$P($G(AWCTOTX(AWCTYPE,2)),U,1)+AWCSEC DO Q
75 ..S $P(AWCTOTX(AWCTYPE,2),U,2)=$P(AWCTOTX(AWCTYPE,2),U,2)+AWCCNT
76 .I +AWCTIME'<1600&(+AWCTIME'>2359) S $P(AWCTOTX(AWCTYPE,3),U,1)=$P($G(AWCTOTX(AWCTYPE,3)),U,1)+AWCSEC DO Q
77 ..S $P(AWCTOTX(AWCTYPE,3),U,2)=$P(AWCTOTX(AWCTYPE,3),U,2)+AWCCNT
78 F X=1:1:3 S AWCTOTX(X,1)=$S($P(AWCTOTX(X,1),U,2)>0:$P(AWCTOTX(X,1),U,1)/$P(AWCTOTX(X,1),U,2),1:0)
79 F X=1:1:3 S AWCTOTX(X,2)=$S($P(AWCTOTX(X,2),U,2)>0:$P(AWCTOTX(X,2),U,1)/$P(AWCTOTX(X,2),U,2),1:0)
80 F X=1:1:3 S AWCTOTX(X,3)=$S($P(AWCTOTX(X,3),U,2)>0:$P(AWCTOTX(X,3),U,1)/$P(AWCTOTX(X,3),U,2),1:0)
81 F X=0:0 S X=$O(AWCTOTX(X)) Q:X="" S Y="" F S Y=$O(AWCTOTX(X,Y)) Q:Y="" W X,$C(9),Y,$C(9),$J(AWCTOTX(X,Y),5,2)_$C(9)_AWCBEGD1,!
82 ;
83SENDIT ; send it
84 D CLOSE^%ZISH("AWCMCPR3"),^%ZISC
85 D EN^AWCMFTP1
86 I AWCX["NT" DO
87 .S CMD="S AWCVAR=$ZF(-1,"_"""erase ftpstatawc.txt"_""""_")" X CMD
88 .S CMD="S AWCVAR=$ZF(-1,"_"""erase "_AWCHFILE_""""_")" X CMD
89 ;
90EXIT K %DT,AWCAVB,AWCBEGDT,AWCBEGTM,AWCCNT,AWCCNTR,AWCDEV,AWCDIV,AWCDIVN1,AWCDIVNM,AWCDTA,AWCENDDT,AWCX,AWCY
91 K AWCENDTM,AWCFILE,AWCPCNTR,AWCSEC,AWCTIME,AWCTTIM,AWCTYPE,AWCVCNTR,AWCZ,DA,T,X,AWCX1,AWCX3,Y
92 K AWC,AWCDIR,AWCDIRL,AWCHFILE,AWCHFILL,AWCOS,AWCVAR,Y,%SUBMIT,VMSC,CMD,AWCHFIL1
93 K ^TMP("AWC",$J),^TMP("AWCTTIM",$J),AWCAVG,AWCBEGD1,AWCDATE,TMP,AWCMANL
94 K ZTSK,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTDTH,AWCHDR1
95 Q
96 ;
97MANUAL S IOP="HOME" D ^%ZIS K IOP
98 S AWCHDR1="Re-run National CPRS Monitors" W @IOF,!,AWCHDR1,!!
99 S %DT="AE",%DT("A")="What day do you want to re-run ? " D ^%DT G:Y<0 EXIT
100 S X=$O(^AWC(177100.13,"C",(Y-.000001))) I X=""!(X>(Y_.2359)) W $C(7),!!,"There is no data in the permanent file for that day.",!! H 2 G MANUAL
101 S AWCBEGDT=Y,AWCMANL=1
102 S ZTSAVE("AWC*")="",ZTIO="",ZTRTN="GENSTAT^AWCMCPR3",ZTDESC=AWCHDR1,ZTDTH=$H D ^%ZTLOAD
103 W:$D(ZTSK) !!,"Queued as task# ",ZTSK,!! H 2 G EXIT
Note: See TracBrowser for help on using the repository browser.