- PRCGPM ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT - IFCAP PURGEMASTER PROCESS ;12/10/97 9:17 AM
- V ;;5.1;IFCAP;**95**;Oct 20, 2000
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;THIS ROUTINE SHOULD BE TASKED TO RUN DAILY AT WHATEVER TIME
- ;THE IRM STAFF FEELS IS APPROPRIATE. IT SHOULD BE RESCHEDULED
- ;TO RUN DAILY. ITS JOB IS TO SPAWN THE APPROPRIATE NUMBER OF
- ;'KILLER' JOBS (^PRCGPMK) AS SPECIFIED IN FILE 443.2.
- ;
- ;IF LEFTOVER INPROCESS JOBS REMAIN IN FILE 443.3, AND THEY ARE OVER
- ; 1 DAY OLD, THEY WILL BE ADDED TO FILE 443.1 HERE
- I $O(^PRC(443.3,0)) DO
- . NEW DA,TODAY,NODE,NODE1,ROU,VARIABLE,MSG
- . S TODAY=+$H,DA=0
- . F S DA=$O(^PRC(443.3,DA)) Q:'DA DO
- . . S NODE=$G(^PRC(443.3,DA,0)) I NODE="" D REMIP^PRCGPM1(DA) QUIT
- . . S NODE1=$G(^PRC(443.3,DA,1)) I NODE1="" D REMIP^PRCGPM1(DA) QUIT
- . . S ROU=$P(NODE,"^",2,3),VARIABLE=$P(NODE,"^",4) I ROU="" D REMIP^PRCGPM1(DA) QUIT
- . . S DATE=+NODE1 Q:TODAY'>DATE
- . . D ADD^PRCGPM1(ROU,VARIABLE,.MSG)
- . . I MSG D REMIP^PRCGPM1(DA)
- . . QUIT
- . QUIT
- D CLN445^PRCGPM1
- ;IT WILL ONLY SPAWN 'SUB-MANAGER' JOBS IF THERE ARE ENTRIES IN
- ;FILE 443.1
- S PARAM=^PRC(443.2,1,0),$P(PARAM,"^",7)=$H
- S STOP=$P(PARAM,"^",3),SAT=$P(PARAM,"^",4),SUN=$P(PARAM,"^",5),HOL=$P(PARAM,"^",6),START=$P(PARAM,"^",7)
- S X=DT_"."_STOP D H^%DTC S STOP=%T
- I STOP<$P(START,",",2) S STOP=($P(START,",",1)+1)_","_STOP
- E S STOP=$P(START,",",1)_","_STOP
- S %H=STOP D YMD^%DTC
- D DOW^%DTC
- I ((SAT&(Y=6))!(SUN&(Y=7))!(HOL&($D(^HOLIDAY(X))))) S $P(STOP,",",2)=$P(START,",",2),STOP=($P(STOP,",")+1)_","_$P(STOP,",",2)
- S NEXTVOL=0 F S NEXTVOL=$O(^PRC(443.2,1,1,NEXTVOL)) Q:'NEXTVOL D
- . N X,CPU S X=$G(^PRC(443.2,1,1,NEXTVOL,0)) Q:X=""
- . S CPU=$P(X,"^"),NUMJOB=$P(X,"^",2)
- . F ZII=1:1:NUMJOB D
- . . S ZTCPU=CPU,ZTRTN="PRCGPMK",ZTDESC="IFCAP PurgeMaster Process",ZTIO="",ZTDTH=$H
- . . S ZTSAVE("STOP")="",ZTKIL=$H+2_",0"
- . . D ^%ZTLOAD W:'$D(ZTQUEUED) !,ZTSK
- . . QUIT
- . QUIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCGPM 1975 printed Mar 13, 2025@21:09:39 Page 2
- PRCGPM ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT - IFCAP PURGEMASTER PROCESS ;12/10/97 9:17 AM
- V ;;5.1;IFCAP;**95**;Oct 20, 2000
- +1 ;Per VHA Directive 2004-038, this routine should not be modified.
- +2 ;THIS ROUTINE SHOULD BE TASKED TO RUN DAILY AT WHATEVER TIME
- +3 ;THE IRM STAFF FEELS IS APPROPRIATE. IT SHOULD BE RESCHEDULED
- +4 ;TO RUN DAILY. ITS JOB IS TO SPAWN THE APPROPRIATE NUMBER OF
- +5 ;'KILLER' JOBS (^PRCGPMK) AS SPECIFIED IN FILE 443.2.
- +6 ;
- +7 ;IF LEFTOVER INPROCESS JOBS REMAIN IN FILE 443.3, AND THEY ARE OVER
- +8 ; 1 DAY OLD, THEY WILL BE ADDED TO FILE 443.1 HERE
- +9 IF $ORDER(^PRC(443.3,0))
- Begin DoDot:1
- +10 NEW DA,TODAY,NODE,NODE1,ROU,VARIABLE,MSG
- +11 SET TODAY=+$HOROLOG
- SET DA=0
- +12 FOR
- SET DA=$ORDER(^PRC(443.3,DA))
- if 'DA
- QUIT
- Begin DoDot:2
- +13 SET NODE=$GET(^PRC(443.3,DA,0))
- IF NODE=""
- DO REMIP^PRCGPM1(DA)
- QUIT
- +14 SET NODE1=$GET(^PRC(443.3,DA,1))
- IF NODE1=""
- DO REMIP^PRCGPM1(DA)
- QUIT
- +15 SET ROU=$PIECE(NODE,"^",2,3)
- SET VARIABLE=$PIECE(NODE,"^",4)
- IF ROU=""
- DO REMIP^PRCGPM1(DA)
- QUIT
- +16 SET DATE=+NODE1
- if TODAY'>DATE
- QUIT
- +17 DO ADD^PRCGPM1(ROU,VARIABLE,.MSG)
- +18 IF MSG
- DO REMIP^PRCGPM1(DA)
- +19 QUIT
- End DoDot:2
- +20 QUIT
- End DoDot:1
- +21 DO CLN445^PRCGPM1
- +22 ;IT WILL ONLY SPAWN 'SUB-MANAGER' JOBS IF THERE ARE ENTRIES IN
- +23 ;FILE 443.1
- +24 SET PARAM=^PRC(443.2,1,0)
- SET $PIECE(PARAM,"^",7)=$HOROLOG
- +25 SET STOP=$PIECE(PARAM,"^",3)
- SET SAT=$PIECE(PARAM,"^",4)
- SET SUN=$PIECE(PARAM,"^",5)
- SET HOL=$PIECE(PARAM,"^",6)
- SET START=$PIECE(PARAM,"^",7)
- +26 SET X=DT_"."_STOP
- DO H^%DTC
- SET STOP=%T
- +27 IF STOP<$PIECE(START,",",2)
- SET STOP=($PIECE(START,",",1)+1)_","_STOP
- +28 IF '$TEST
- SET STOP=$PIECE(START,",",1)_","_STOP
- +29 SET %H=STOP
- DO YMD^%DTC
- +30 DO DOW^%DTC
- +31 IF ((SAT&(Y=6))!(SUN&(Y=7))!(HOL&($DATA(^HOLIDAY(X)))))
- SET $PIECE(STOP,",",2)=$PIECE(START,",",2)
- SET STOP=($PIECE(STOP,",")+1)_","_$PIECE(STOP,",",2)
- +32 SET NEXTVOL=0
- FOR
- SET NEXTVOL=$ORDER(^PRC(443.2,1,1,NEXTVOL))
- if 'NEXTVOL
- QUIT
- Begin DoDot:1
- +33 NEW X,CPU
- SET X=$GET(^PRC(443.2,1,1,NEXTVOL,0))
- if X=""
- QUIT
- +34 SET CPU=$PIECE(X,"^")
- SET NUMJOB=$PIECE(X,"^",2)
- +35 FOR ZII=1:1:NUMJOB
- Begin DoDot:2
- +36 SET ZTCPU=CPU
- SET ZTRTN="PRCGPMK"
- SET ZTDESC="IFCAP PurgeMaster Process"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- +37 SET ZTSAVE("STOP")=""
- SET ZTKIL=$HOROLOG+2_",0"
- +38 DO ^%ZTLOAD
- if '$DATA(ZTQUEUED)
- WRITE !,ZTSK
- +39 QUIT
- End DoDot:2
- +40 QUIT
- End DoDot:1
- +41 QUIT
