AWCMCPR1 ;VISN 7/THM-CPRS MONITOR ;Feb 27, 2004
;;7.3;TOOLKIT;**84,86**;Jan 09, 2004
;
W !!,$C(7),"You cannot run this program directly.",!,"Application use only !!",!! H 2 Q ;enter properly
;
STRT1 ; tiu
N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
I $P(AWCDTA,U,2)'=1 G ENDQ ;tiu
S AWCTYPE=1,AWCSTRT=$H
Q
;
STRT2 ; lab
N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
I $P(AWCDTA,U,3)'=1 G ENDQ ;lab
S AWCTYPE=2,AWCSTRT=$H
Q
;
STRT3 ; reminders
N AWCDTA S AWCDTA=$G(^AWC(177100.12,1,0))
I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
I $P(AWCDTA,U,4)'=1 G ENDQ ;reminders
S AWCTYPE=3,AWCSTRT=$H
K AWCDTA
Q
;
END ; record the data
; quit if turning on/back on in middle of transaction (AWCTYPE or AWCSTRT missing)
I '$D(AWCTYPE)!('$D(AWCSTRT)) G ENDQ
S AWCDTA=$G(^AWC(177100.12,1,0))
I $P(AWCDTA,U,17)'=1 G ENDQ ;master switch
I $P(AWCDTA,U,2)'=1 G ENDQ ;tiu
I $P(AWCDTA,U,3)'=1 G ENDQ ;lab
I $P(AWCDTA,U,4)'=1 G ENDQ ;reminder
S AWCEND=$H
L +^XTMP("AWCCPRS",.5):1 G:'$T ENDQ
S AWCDA=+$G(^XTMP("AWCCPRS",.5))
I AWCDA>50000000 S AWCDA=0 ; reset to zero at fifty million entries
S AWCDA=AWCDA+1,^XTMP("AWCCPRS",.5)=AWCDA
L -^XTMP("AWCCPRS",.5)
S AWCFMDT=$$HTFM^XLFDT(AWCSTRT)
S ^XTMP("AWCCPRS",AWCFMDT,AWCDA,0)=AWCSTRT_U_AWCEND_U_DUZ_U_(+$G(DUZ(2)))_U_AWCTYPE
;
ENDQ K AWCDTA,AWCSEC,AWCFMDT,AWCTYPE,AWCSTRT,AWCEND,DO,DD,DIC,DIE,AWCDA
Q
;
PPAGE ; entry point to create updated .htm file
; possible values for AWCX are VMS, VMSC, or NT
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"
; To double check for OS
I $T(OS^%ZOSV)'="" D
. I $$OS^%ZOSV()="VMS" S AWCX="VMSC"
. I $$OS^%ZOSV()="NT" S AWCX="NT"
;
K TMP("AWC") D DT^DICRW
Q:'$D(^AWC(177100.12,1,0)) ;param file not set up
; extract the parameters
S AWCDTA=$G(^AWC(177100.12,1,0))
S AWCDTA1=$G(^AWC(177100.12,1,1))
S AWCDHRS=$P(AWCDTA,U,7) I AWCDHRS="" S AWCDHRS=8 ;# hours to display
S X=$P(AWCDTA,U,8) S AWCMXSEC=$S(X]"":X,1:30) ;number of seconds to display
S X=$P(AWCDTA,U,9) S AWCTIULN=$S(X]"":X,1:"192,0,0") ;rgb code tiu line
S X=$P(AWCDTA,U,10) S AWCLABLN=$S(X]"":X,1:"0,192,0") ;rgb code lab line
S X=$P(AWCDTA,U,11) S AWCREMLN=$S(X]"":X,1:"0,0,192") ;rgb code reminder line
S X=$P(AWCDTA,U,12) S AWCGRDON=$S(X="y":"true",X="n":"false",1:"true")
S X=$P(AWCDTA,U,13) S AWCBKGRN=$S(X]"":X,1:"230,230,230") ;rgb code
S X=$P(AWCDTA1,U,3) S AWCMSRV=$S(X]"":X,1:"") ;server
S X=$P(AWCDTA1,U,4) S AWCMUSR=$S(X]"":X,1:"") ;user
S X=$P(AWCDTA1,U,5) S AWCMPW=$S(X]"":X,1:"") ;passwd
;
K AWCDTA D NOW^%DTC S (AWCENDDT,AWCCURTM)=%,AWCTSEC=3600*AWCDHRS
S AWCI1=$P(%H,",",1),AWCI2=$P(%H,",",2)
S AWCI2=(AWCI2-AWCTSEC) I AWCI2<0 S AWCI2=AWCI2+86400,AWCI1=AWCI1-1
S %H=AWCI1_","_AWCI2 D YMD^%DTC S AWCBEGDT=X_%
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
S AWCBEGTM=+X
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
S AWCENDTM=+X K ^TMP("AWCTTIM",$J)
; 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
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
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
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
;
SORT ; sort the data into a TMP file
K ^TMP($J)
F AWCSRTDT=(AWCBEGDT-.000001):0 S AWCSRTDT=$O(^XTMP("AWCCPRS",AWCSRTDT)) Q:AWCSRTDT=""!(AWCSRTDT>AWCENDDT) DO
.F DA=0:0 S DA=$O(^XTMP("AWCCPRS",AWCSRTDT,DA)) Q:DA="" DO
..S AWCDTA=$G(^XTMP("AWCCPRS",AWCSRTDT,DA,0)),AWCDIV=$P(AWCDTA,U,4),AWCTYPE=$P(AWCDTA,U,5)
..I AWCDIV="" S AWCDIV=+$$SITE^VASITE ;for people without division assignments
..S ^TMP($J,AWCDIV,AWCTYPE,AWCSRTDT,DA)=""
;
DIVS ; count the divisions for drop-down box on web page (used in AWCMCPR2)
I '$D(^TMP($J)) D NODATA G PPAGE ;no data yet for time frame being processed
S AWCDCNTR=0
F AWCDIV=0:0 S AWCDIV=$O(^TMP($J,AWCDIV)) Q:AWCDIV="" DO
.S AWCFDIV(AWCDIV)=$P(^DIC(4,AWCDIV,0),U)_U_$P($G(^DIC(4,+AWCDIV,99)),U)_U
.S AWCDCNTR=AWCDCNTR+1
; if only one division no drop-down box is needed
I AWCDCNTR=1 K AWCFDIV
; generate one HTML page per facility
DIVPG F AWCDIV=0:0 S AWCDIV=$O(^TMP($J,AWCDIV)) Q:AWCDIV="" DO G:POP EXIT
.S AWCDEV=$P($G(^AWC(177100.12,1,0)),U,5) I AWCDEV="" S POP=1 Q ;no HFS device in param file
.S (AWCDIVNM,AWCDIVN1)=$P(^DIC(4,AWCDIV,0),U)
.S AWCDIVNM=$P($G(^DIC(4,+AWCDIV,99)),U) Q:AWCDIVNM=""
.S AWCFILE=$P(^AWC(177100.12,1,0),U,6)_"_"_AWCDIVNM_".htm" ;web page name with division number
.Q:AWCFILE=("_"_AWCDIV)!(AWCDEV="") ;webpage or device is missing in parameter file
.; Check VMS or NT before you put the \ in the file name
.I AWCX="NT" D
..S AWCZ=$L(AWCDEV) I $E(AWCDEV,AWCZ,AWCZ)'="\" S AWCDEV=AWCDEV_"\" ;add \ if missing
.D OPEN^%ZISH("AWCCPR1",AWCDEV,AWCFILE,"W") Q:POP
.S AWCHFIL1=AWCDEV_AWCFILE ;needed for AWCMFTP at end
.U IO D PART1^AWCMCPR2 ;part 1 of web page
.;
TMPALL .; make the TMP("AWC", array with all possible hours, increments of ten, for all types 1,2,3, with zero values
.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"
.;
DVALS .; count the number of data values to display on graph
.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
.S AWCVCNTR=AWCVCNTR/3 ;divide by 3 graph lines
.; get the data by date range provided and sort the data
.F AWCTYPE=0:0 S AWCTYPE=$O(^TMP($J,AWCDIV,AWCTYPE)) Q:AWCTYPE="" DO
..F AWCDATE=(AWCBEGDT-.000001):0 S AWCDATE=$O(^TMP($J,AWCDIV,AWCTYPE,AWCDATE)) Q:AWCDATE=""!(AWCDATE>AWCENDDT) DO
...F DA=0:0 S DA=$O(^TMP($J,AWCDIV,AWCTYPE,AWCDATE,DA)) Q:DA="" DO
....S AWCDTA=$G(^XTMP("AWCCPRS",AWCDATE,DA,0)),AWCXSTRT=$P(AWCDTA,U),AWCXEND=$P(AWCDTA,U,2)
....S AWCSEC=$$HDIFF^XLFDT(AWCXEND,AWCXSTRT,2)
....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 and put with interval
....S AWCX1=$E(X,1,2),AWCX3=$E(X,3,4) ;strip hours and minutes, no seconds although they are there
....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 ....; set in TMP("AWC", array ONLY if within our selected range
....I $D(TMP("AWC",AWCTYPE,(-9999+AWCTIME))) DO
.....S $P(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME))),U)=$P($G(TMP("AWC",AWCTYPE,-9999+(+AWCTIME))),U)+AWCSEC
.....S $P(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME))),U,2)=$P($G(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME)))),U,2)+1
....I $D(TMP("AWC",AWCTYPE,+AWCTIME)) DO
.....S $P(TMP("AWC",AWCTYPE,+AWCTIME),U)=$P($G(TMP("AWC",AWCTYPE,+AWCTIME)),U)+AWCSEC
.....S $P(TMP("AWC",AWCTYPE,+AWCTIME),U,2)=$P($G(TMP("AWC",AWCTYPE,+AWCTIME)),U,2)+1
.;
PART2 .D PART2^AWCMCPR2 ;part II of the HTML code
.; ftp the file
.D EN^AWCMFTP
I AWCX="NT" S CMD="S AWCVAR=$ZF(-1,"_"""erase ftpawc.txt"_""""_")" X CMD
I AWCX="VMS"!(AWCX="VMSC") D PURDEL^AWCMFTP
;
EXIT D ^%ZISC
K %,%H,AWCC,AWCAVG,AWCCNT,AWCDATE,AWCDEV,AWCDHRS,AWCDIV,AWCDT,AWCDTA,AWCEND,AWCFILE,AWCFMDT,AWCSEC,AWCY,AWCX
K AWCSTRT,AWCTIME,AWCTYPE,AWCZ,AWCBEGTM,DA,DD,DIC,DIE,DO,DR,AWCENDDT,AWCENDTM,AWCLBCNT,AWCPARAM,AWCPCNTR,AWCFDIVN
K POP,AWCTTIM,AWCVCNTR,X,AWCX1,AWCX3,Y,AWCBEGDT,AWCCURTM,AWCI1,AWCI2,T,AWCTSEC,Z,AWCDIVNM,AWCWL,AWCDVDTA
K AWCTIULN,AWCLABLN,AWCREMLN,AWCMXSEC,AWCGRDON,AWCBKGRN,AWCDIVN1,AWCFDIV,AWCDVNM,AWCDVNB,AWCWEBRT,AWCDCNTR,AWCFXDTA
K AWCOS,AWCDTA1,AWCHFIL1,AWCMPW,AWCMSRV,AWCMUSR,AWCMCP,AWCSITE,AWCSITEN,AWCVMSP,AWCOS,AWCSRTDT,AWCXDIV,YYY
K %I,%ZISHO,%ZISUB,%ZISHF,AWCWBFLD,CMD,AWC,AWCDIR,AWCDIRL,AWCHFILE,AWCHFILL,AWCOS,AWCVAR,Y,%SUBMIT,VMSC,AWCXDA
K ^TMP("AWCTTIM",$J),^TMP($J),TMP("AWC"),AWCXSTRT,AWCXEND,XDUZ,TMP
Q
;
NODATA ; handle no data for the day-create a zero, dummy record for the home facility.
; this only occurs when a page is due to be run but no activity yet.
S (AWCSTRT,AWCEND)=$H
S AWCXDIV=$P($G(^AWC(177100.12,1,1)),U,2),AWCXDA=$O(^DIC(4,"D",AWCXDIV,0)) Q:AWCXDA=""
S AWCXDIV=$P($G(^DIC(4,AWCXDA,99)),U) Q:AWCXDIV=""
S XDUZ=.5,XDUZ(2)=AWCXDIV,AWCTYPE=1
L +^XTMP("AWCCPRS",.5):1 Q:'$T
S AWCDA=+$G(^XTMP("AWCCPRS",.5)),AWCDA=AWCDA+1,^XTMP("AWCCPRS",.5)=AWCDA
L -^XTMP("AWCCPRS",.5)
S AWCFMDT=$$HTFM^XLFDT(AWCSTRT)
S ^XTMP("AWCCPRS",AWCFMDT,AWCDA,0)=AWCSTRT_U_AWCEND_U_XDUZ_U_(+$G(XDUZ(2)))_U_AWCTYPE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAWCMCPR1 9340 printed Apr 09, 2024@21:45:04 Page 2
AWCMCPR1 ;VISN 7/THM-CPRS MONITOR ;Feb 27, 2004
+1 ;;7.3;TOOLKIT;**84,86**;Jan 09, 2004
+2 ;
+3 ;enter properly
WRITE !!,$CHAR(7),"You cannot run this program directly.",!,"Application use only !!",!!
HANG 2
QUIT
+4 ;
STRT1 ; tiu
+1 NEW AWCDTA
SET AWCDTA=$GET(^AWC(177100.12,1,0))
+2 ;master switch
IF $PIECE(AWCDTA,U,17)'=1
GOTO ENDQ
+3 ;tiu
IF $PIECE(AWCDTA,U,2)'=1
GOTO ENDQ
+4 SET AWCTYPE=1
SET AWCSTRT=$HOROLOG
+5 QUIT
+6 ;
STRT2 ; lab
+1 NEW AWCDTA
SET AWCDTA=$GET(^AWC(177100.12,1,0))
+2 ;master switch
IF $PIECE(AWCDTA,U,17)'=1
GOTO ENDQ
+3 ;lab
IF $PIECE(AWCDTA,U,3)'=1
GOTO ENDQ
+4 SET AWCTYPE=2
SET AWCSTRT=$HOROLOG
+5 QUIT
+6 ;
STRT3 ; reminders
+1 NEW AWCDTA
SET AWCDTA=$GET(^AWC(177100.12,1,0))
+2 ;master switch
IF $PIECE(AWCDTA,U,17)'=1
GOTO ENDQ
+3 ;reminders
IF $PIECE(AWCDTA,U,4)'=1
GOTO ENDQ
+4 SET AWCTYPE=3
SET AWCSTRT=$HOROLOG
+5 KILL AWCDTA
+6 QUIT
+7 ;
END ; record the data
+1 ; quit if turning on/back on in middle of transaction (AWCTYPE or AWCSTRT missing)
+2 IF '$DATA(AWCTYPE)!('$DATA(AWCSTRT))
GOTO ENDQ
+3 SET AWCDTA=$GET(^AWC(177100.12,1,0))
+4 ;master switch
IF $PIECE(AWCDTA,U,17)'=1
GOTO ENDQ
+5 ;tiu
IF $PIECE(AWCDTA,U,2)'=1
GOTO ENDQ
+6 ;lab
IF $PIECE(AWCDTA,U,3)'=1
GOTO ENDQ
+7 ;reminder
IF $PIECE(AWCDTA,U,4)'=1
GOTO ENDQ
+8 SET AWCEND=$HOROLOG
+9 LOCK +^XTMP("AWCCPRS",.5):1
if '$TEST
GOTO ENDQ
+10 SET AWCDA=+$GET(^XTMP("AWCCPRS",.5))
+11 ; reset to zero at fifty million entries
IF AWCDA>50000000
SET AWCDA=0
+12 SET AWCDA=AWCDA+1
SET ^XTMP("AWCCPRS",.5)=AWCDA
+13 LOCK -^XTMP("AWCCPRS",.5)
+14 SET AWCFMDT=$$HTFM^XLFDT(AWCSTRT)
+15 SET ^XTMP("AWCCPRS",AWCFMDT,AWCDA,0)=AWCSTRT_U_AWCEND_U_DUZ_U_(+$GET(DUZ(2)))_U_AWCTYPE
+16 ;
ENDQ KILL AWCDTA,AWCSEC,AWCFMDT,AWCTYPE,AWCSTRT,AWCEND,DO,DD,DIC,DIE,AWCDA
+1 QUIT
+2 ;
PPAGE ; entry point to create updated .htm file
+1 ; possible values for AWCX are VMS, VMSC, or NT
+2 SET AWCX=""
SET AWCOS=$PIECE(^%ZOSF("OS"),U)
+3 IF AWCOS["VAX DSM"
SET AWCX="VMS"
+4 IF AWCOS["OpenM-VMS"
SET AWCX="VMSC"
+5 IF AWCOS["OpenM"
SET AWCX="VMSC"
+6 ; To double check for OS
+7 IF $TEXT(OS^%ZOSV)'=""
Begin DoDot:1
+8 IF $$OS^%ZOSV()="VMS"
SET AWCX="VMSC"
+9 IF $$OS^%ZOSV()="NT"
SET AWCX="NT"
End DoDot:1
+10 ;
+11 KILL TMP("AWC")
DO DT^DICRW
+12 ;param file not set up
if '$DATA(^AWC(177100.12,1,0))
QUIT
+13 ; extract the parameters
+14 SET AWCDTA=$GET(^AWC(177100.12,1,0))
+15 SET AWCDTA1=$GET(^AWC(177100.12,1,1))
+16 ;# hours to display
SET AWCDHRS=$PIECE(AWCDTA,U,7)
IF AWCDHRS=""
SET AWCDHRS=8
+17 ;number of seconds to display
SET X=$PIECE(AWCDTA,U,8)
SET AWCMXSEC=$SELECT(X]"":X,1:30)
+18 ;rgb code tiu line
SET X=$PIECE(AWCDTA,U,9)
SET AWCTIULN=$SELECT(X]"":X,1:"192,0,0")
+19 ;rgb code lab line
SET X=$PIECE(AWCDTA,U,10)
SET AWCLABLN=$SELECT(X]"":X,1:"0,192,0")
+20 ;rgb code reminder line
SET X=$PIECE(AWCDTA,U,11)
SET AWCREMLN=$SELECT(X]"":X,1:"0,0,192")
+21 SET X=$PIECE(AWCDTA,U,12)
SET AWCGRDON=$SELECT(X="y":"true",X="n":"false",1:"true")
+22 ;rgb code
SET X=$PIECE(AWCDTA,U,13)
SET AWCBKGRN=$SELECT(X]"":X,1:"230,230,230")
+23 ;server
SET X=$PIECE(AWCDTA1,U,3)
SET AWCMSRV=$SELECT(X]"":X,1:"")
+24 ;user
SET X=$PIECE(AWCDTA1,U,4)
SET AWCMUSR=$SELECT(X]"":X,1:"")
+25 ;passwd
SET X=$PIECE(AWCDTA1,U,5)
SET AWCMPW=$SELECT(X]"":X,1:"")
+26 ;
+27 KILL AWCDTA
DO NOW^%DTC
SET (AWCENDDT,AWCCURTM)=%
SET AWCTSEC=3600*AWCDHRS
+28 SET AWCI1=$PIECE(%H,",",1)
SET AWCI2=$PIECE(%H,",",2)
+29 SET AWCI2=(AWCI2-AWCTSEC)
IF AWCI2<0
SET AWCI2=AWCI2+86400
SET AWCI1=AWCI1-1
+30 SET %H=AWCI1_","_AWCI2
DO YMD^%DTC
SET AWCBEGDT=X_%
+31 ;format to four digits, including any leading zeros
SET X=$EXTRACT(%,2,4)
SET X=X_"0"
SET X=$SELECT($LENGTH(X)<4:X_"0",1:X)
+32 SET AWCBEGTM=+X
+33 ;format to four digits as above
SET X=$PIECE(AWCCURTM,".",2)
SET X=($EXTRACT(X,1,3)_"0")
SET X=$SELECT($LENGTH(X)<4:X_"0",1:X)
+34 SET AWCENDTM=+X
KILL ^TMP("AWCTTIM",$JOB)
+35 ; This loop skips 60 due to adding 10 to starting number. These two lines
+36 ; cause it to print 0-50 min, skipping 60, like this: 210 220,230,240,250,300
+37 ;before midnight
IF AWCBEGTM>AWCENDTM
FOR X=AWCBEGTM:10:2350
SET ^TMP("AWCTTIM",$JOB,(-9999+X))=""
if $EXTRACT(X,($LENGTH(X)-1),$LENGTH(X))=50
SET X=X+40
if X=2360
SET X="0"
+38 ;after midnight
IF AWCBEGTM>AWCENDTM
FOR X=0:10:AWCENDTM
SET ^TMP("AWCTTIM",$JOB,X)=""
if $EXTRACT(X,($LENGTH(X)-1),$LENGTH(X))=50
SET X=X+40
+39 ;normal times
IF AWCENDTM>AWCBEGTM
FOR X=AWCBEGTM:10:AWCENDTM
SET ^TMP("AWCTTIM",$JOB,X)=""
IF $EXTRACT(X,($LENGTH(X)-1),($LENGTH(X)))=50
SET X=X+40
+40 ;
SORT ; sort the data into a TMP file
+1 KILL ^TMP($JOB)
+2 FOR AWCSRTDT=(AWCBEGDT-.000001):0
SET AWCSRTDT=$ORDER(^XTMP("AWCCPRS",AWCSRTDT))
if AWCSRTDT=""!(AWCSRTDT>AWCENDDT)
QUIT
Begin DoDot:1
+3 FOR DA=0:0
SET DA=$ORDER(^XTMP("AWCCPRS",AWCSRTDT,DA))
if DA=""
QUIT
Begin DoDot:2
+4 SET AWCDTA=$GET(^XTMP("AWCCPRS",AWCSRTDT,DA,0))
SET AWCDIV=$PIECE(AWCDTA,U,4)
SET AWCTYPE=$PIECE(AWCDTA,U,5)
+5 ;for people without division assignments
IF AWCDIV=""
SET AWCDIV=+$$SITE^VASITE
+6 SET ^TMP($JOB,AWCDIV,AWCTYPE,AWCSRTDT,DA)=""
End DoDot:2
End DoDot:1
+7 ;
DIVS ; count the divisions for drop-down box on web page (used in AWCMCPR2)
+1 ;no data yet for time frame being processed
IF '$DATA(^TMP($JOB))
DO NODATA
GOTO PPAGE
+2 SET AWCDCNTR=0
+3 FOR AWCDIV=0:0
SET AWCDIV=$ORDER(^TMP($JOB,AWCDIV))
if AWCDIV=""
QUIT
Begin DoDot:1
+4 SET AWCFDIV(AWCDIV)=$PIECE(^DIC(4,AWCDIV,0),U)_U_$PIECE($GET(^DIC(4,+AWCDIV,99)),U)_U
+5 SET AWCDCNTR=AWCDCNTR+1
End DoDot:1
+6 ; if only one division no drop-down box is needed
+7 IF AWCDCNTR=1
KILL AWCFDIV
+8 ; generate one HTML page per facility
DIVPG FOR AWCDIV=0:0
SET AWCDIV=$ORDER(^TMP($JOB,AWCDIV))
if AWCDIV=""
QUIT
Begin DoDot:1
+1 ;no HFS device in param file
SET AWCDEV=$PIECE($GET(^AWC(177100.12,1,0)),U,5)
IF AWCDEV=""
SET POP=1
QUIT
+2 SET (AWCDIVNM,AWCDIVN1)=$PIECE(^DIC(4,AWCDIV,0),U)
+3 SET AWCDIVNM=$PIECE($GET(^DIC(4,+AWCDIV,99)),U)
if AWCDIVNM=""
QUIT
+4 ;web page name with division number
SET AWCFILE=$PIECE(^AWC(177100.12,1,0),U,6)_"_"_AWCDIVNM_".htm"
+5 ;webpage or device is missing in parameter file
if AWCFILE=("_"_AWCDIV)!(AWCDEV="")
QUIT
+6 ; Check VMS or NT before you put the \ in the file name
+7 IF AWCX="NT"
Begin DoDot:2
+8 ;add \ if missing
SET AWCZ=$LENGTH(AWCDEV)
IF $EXTRACT(AWCDEV,AWCZ,AWCZ)'="\"
SET AWCDEV=AWCDEV_"\"
End DoDot:2
+9 DO OPEN^%ZISH("AWCCPR1",AWCDEV,AWCFILE,"W")
if POP
QUIT
+10 ;needed for AWCMFTP at end
SET AWCHFIL1=AWCDEV_AWCFILE
+11 ;part 1 of web page
USE IO
DO PART1^AWCMCPR2
+12 ;
TMPALL ; make the TMP("AWC", array with all possible hours, increments of ten, for all types 1,2,3, with zero values
+1 FOR T=1:1:3
FOR X=-99999:0
SET X=$ORDER(^TMP("AWCTTIM",$JOB,X))
if X=""
QUIT
SET TMP("AWC",T,X)="0^0"
+2 ;
DVALS ; count the number of data values to display on graph
+1 SET AWCVCNTR=0
FOR X=0:0
SET X=$ORDER(TMP("AWC",X))
if X=""
QUIT
FOR Y=0:0
SET Y=$ORDER(TMP("AWC",X,Y))
if Y=""
QUIT
SET AWCVCNTR=AWCVCNTR+1
+2 ;divide by 3 graph lines
SET AWCVCNTR=AWCVCNTR/3
+3 ; get the data by date range provided and sort the data
+4 FOR AWCTYPE=0:0
SET AWCTYPE=$ORDER(^TMP($JOB,AWCDIV,AWCTYPE))
if AWCTYPE=""
QUIT
Begin DoDot:2
+5 FOR AWCDATE=(AWCBEGDT-.000001):0
SET AWCDATE=$ORDER(^TMP($JOB,AWCDIV,AWCTYPE,AWCDATE))
if AWCDATE=""!(AWCDATE>AWCENDDT)
QUIT
Begin DoDot:3
+6 FOR DA=0:0
SET DA=$ORDER(^TMP($JOB,AWCDIV,AWCTYPE,AWCDATE,DA))
if DA=""
QUIT
Begin DoDot:4
+7 SET AWCDTA=$GET(^XTMP("AWCCPRS",AWCDATE,DA,0))
SET AWCXSTRT=$PIECE(AWCDTA,U)
SET AWCXEND=$PIECE(AWCDTA,U,2)
+8 SET AWCSEC=$$HDIFF^XLFDT(AWCXEND,AWCXSTRT,2)
+9 SET Y=AWCDATE
XECUTE ^DD("DD")
SET X=$PIECE(Y,"@",2)
SET X=$TRANSLATE(X,":","")
+10 ; sort the times ; AWCX1 is the hours ;AWCX3 is the minutes
+11 ; use 10-minute intervals and put with interval
+12 ;strip hours and minutes, no seconds although they are there
SET AWCX1=$EXTRACT(X,1,2)
SET AWCX3=$EXTRACT(X,3,4)
+13 IF "^00^01^02^03^04^05^"[(U_AWCX3_U)
SET AWCX3="00"
+14 IF "^06^07^08^09^10^11^12^13^14^15^"[(U_AWCX3_U)
SET AWCX3="10"
+15 IF "^16^17^18^19^20^21^22^23^24^25^"[(U_AWCX3_U)
SET AWCX3="20"
+16 IF "^26^27^28^29^30^31^32^33^34^35^"[(U_AWCX3_U)
SET AWCX3="30"
+17 IF "^36^37^38^39^40^41^42^43^44^45^"[(U_AWCX3_U)
SET AWCX3="40"
+18 IF "^46^47^48^49^50^51^52^53^54^55^"[(U_AWCX3_U)
SET AWCX3="50"
+19 IF "^56^57^58^59^"[(U_AWCX3_U)
SET AWCX3="60"
+20 IF AWCX3=60
SET AWCX3="00"
SET AWCX1=AWCX1+1
+21 IF AWCX1=24
SET AWCX1="00"
+22 SET AWCTIME=+(AWCX1_AWCX3)
+23 ;
SETTMP ; set in TMP("AWC", array ONLY if within our selected range
+1 IF $DATA(TMP("AWC",AWCTYPE,(-9999+AWCTIME)))
Begin DoDot:5
+2 SET $PIECE(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME))),U)=$PIECE($GET(TMP("AWC",AWCTYPE,-9999+(+AWCTIME))),U)+AWCSEC
+3 SET $PIECE(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME))),U,2)=$PIECE($GET(TMP("AWC",AWCTYPE,(-9999+(+AWCTIME)))),U,2)+1
End DoDot:5
+4 IF $DATA(TMP("AWC",AWCTYPE,+AWCTIME))
Begin DoDot:5
+5 SET $PIECE(TMP("AWC",AWCTYPE,+AWCTIME),U)=$PIECE($GET(TMP("AWC",AWCTYPE,+AWCTIME)),U)+AWCSEC
+6 SET $PIECE(TMP("AWC",AWCTYPE,+AWCTIME),U,2)=$PIECE($GET(TMP("AWC",AWCTYPE,+AWCTIME)),U,2)+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+7 ;
PART2 ;part II of the HTML code
DO PART2^AWCMCPR2
+1 ; ftp the file
+2 DO EN^AWCMFTP
End DoDot:1
if POP
GOTO EXIT
+3 IF AWCX="NT"
SET CMD="S AWCVAR=$ZF(-1,"_"""erase ftpawc.txt"_""""_")"
XECUTE CMD
+4 IF AWCX="VMS"!(AWCX="VMSC")
DO PURDEL^AWCMFTP
+5 ;
EXIT DO ^%ZISC
+1 KILL %,%H,AWCC,AWCAVG,AWCCNT,AWCDATE,AWCDEV,AWCDHRS,AWCDIV,AWCDT,AWCDTA,AWCEND,AWCFILE,AWCFMDT,AWCSEC,AWCY,AWCX
+2 KILL AWCSTRT,AWCTIME,AWCTYPE,AWCZ,AWCBEGTM,DA,DD,DIC,DIE,DO,DR,AWCENDDT,AWCENDTM,AWCLBCNT,AWCPARAM,AWCPCNTR,AWCFDIVN
+3 KILL POP,AWCTTIM,AWCVCNTR,X,AWCX1,AWCX3,Y,AWCBEGDT,AWCCURTM,AWCI1,AWCI2,T,AWCTSEC,Z,AWCDIVNM,AWCWL,AWCDVDTA
+4 KILL AWCTIULN,AWCLABLN,AWCREMLN,AWCMXSEC,AWCGRDON,AWCBKGRN,AWCDIVN1,AWCFDIV,AWCDVNM,AWCDVNB,AWCWEBRT,AWCDCNTR,AWCFXDTA
+5 KILL AWCOS,AWCDTA1,AWCHFIL1,AWCMPW,AWCMSRV,AWCMUSR,AWCMCP,AWCSITE,AWCSITEN,AWCVMSP,AWCOS,AWCSRTDT,AWCXDIV,YYY
+6 KILL %I,%ZISHO,%ZISUB,%ZISHF,AWCWBFLD,CMD,AWC,AWCDIR,AWCDIRL,AWCHFILE,AWCHFILL,AWCOS,AWCVAR,Y,%SUBMIT,VMSC,AWCXDA
+7 KILL ^TMP("AWCTTIM",$JOB),^TMP($JOB),TMP("AWC"),AWCXSTRT,AWCXEND,XDUZ,TMP
+8 QUIT
+9 ;
NODATA ; handle no data for the day-create a zero, dummy record for the home facility.
+1 ; this only occurs when a page is due to be run but no activity yet.
+2 SET (AWCSTRT,AWCEND)=$HOROLOG
+3 SET AWCXDIV=$PIECE($GET(^AWC(177100.12,1,1)),U,2)
SET AWCXDA=$ORDER(^DIC(4,"D",AWCXDIV,0))
if AWCXDA=""
QUIT
+4 SET AWCXDIV=$PIECE($GET(^DIC(4,AWCXDA,99)),U)
if AWCXDIV=""
QUIT
+5 SET XDUZ=.5
SET XDUZ(2)=AWCXDIV
SET AWCTYPE=1
+6 LOCK +^XTMP("AWCCPRS",.5):1
if '$TEST
QUIT
+7 SET AWCDA=+$GET(^XTMP("AWCCPRS",.5))
SET AWCDA=AWCDA+1
SET ^XTMP("AWCCPRS",.5)=AWCDA
+8 LOCK -^XTMP("AWCCPRS",.5)
+9 SET AWCFMDT=$$HTFM^XLFDT(AWCSTRT)
+10 SET ^XTMP("AWCCPRS",AWCFMDT,AWCDA,0)=AWCSTRT_U_AWCEND_U_XDUZ_U_(+$GET(XDUZ(2)))_U_AWCTYPE
+11 QUIT
