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