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