source: FOIAVistA/tag/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/AWCMCPR3.m@ 636

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