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 Sep 23, 2025@19:40:55 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
