- 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 Jan 18, 2025@03:39:51 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