AWCMCPR3.m

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