DGPTFN1 ;ISP/RFR - REGISTRATION EVENT NOTIFIER;Aug 24, 2020@16:27
;;5.3;Registration;**932,1020,1076**;Aug 13, 1993;Build 4
;
Q
EN ;NOTIFY PACKAGES OF EVENT(S)
I '$D(ZTQUEUED) D
.W @IOF
.W !?19,"* * * REGISTRATION EVENT NOTIFIER * * *",!
N NAME,NODE,DIC,X,EXIT,IEN,FILE,TYPES
;TYPES(DATA_NODE_NAME)=PROTOCOL_NAME
S TYPES("DG PTF ICD NOTIFIER")="DG PTF ICD DIAGNOSIS NOTIFIER"
S TYPES("DG PTF ICD OP NOTIFIER")="DG PTF ICD PROCEDURE NOTIFIER"
S TYPES("DG SA FILE ENTRY NOTIFIER")="DG SA FILE ENTRY NOTIFIER"
S NAME="" F S NAME=$O(TYPES(NAME)) Q:NAME=""!($G(EXIT)) D
.I '$D(ZTQUEUED) W !,"PROCESSING "_NAME_" MESSAGES:",!
.I '$D(^XTMP(NAME))!($O(^XTMP(NAME,0))="") D Q
..I '$D(ZTQUEUED) W " THERE ARE NO DATA CHANGE MESSAGES TO PROCESS.",! H 3
..I $D(^XTMP(NAME)) K ^XTMP(NAME)
.L +^XTMP(NAME):DILOCKTM
.I '$T D Q
..I '$D(ZTQUEUED) W !,"ANOTHER PROCESS IS ALREADY PROCESSING DATA CHANGE MESSAGES.",! H 3
..S EXIT=1
.K ^TMP(NAME,$J)
.S NODE=0 F S NODE=$O(^XTMP(NAME,NODE)) Q:NODE="" D
..I $E(NODE,1)'?1N W " SKIPPING """_NODE_"""",! Q
..I '$D(ZTQUEUED) W " PROCESSING """_NODE_"""..."
..I NAME="DG PTF ICD NOTIFIER"!(NAME="DG PTF ICD OP NOTIFIER") D
...S FILE=$G(^XTMP(NAME,NODE,"FILE"))
...K ^XTMP(NAME,NODE,"FILE")
..M ^TMP(NAME,$J)=^XTMP(NAME,NODE)
..S DIC=101,X=TYPES(NAME)
..D EN^XQOR
..I NAME="DG PTF ICD NOTIFIER"!(NAME="DG PTF ICD OP NOTIFIER"),FILE'="" D
...S IEN=$G(^XTMP(NAME,NODE,"IENS")),IEN=$P(IEN,",",$L(IEN,",")-1) Q:IEN=""
...K ^XTMP(NAME,"B",FILE,IEN)
..I NAME="DG SA FILE ENTRY NOTIFIER CACHE" D
...S IEN=$G(^XTMP(NAME,NODE,"IEN")) Q:IEN=""
...K ^XTMP(NAME,"B",IEN)
..K DIC,X,^TMP(NAME,$J),^XTMP(NAME,NODE)
..I '$D(ZTQUEUED) W "DONE",!
.K ^XTMP(NAME)
.L -^XTMP(NAME)
.W "FINISHED PROCESSING "_NAME_" MESSAGES.",!
I '$D(ZTQUEUED) W !,"FINISHED PROCESSING ALL DATA CHANGE MESSAGES.",! H 3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTFN1 1902 printed Sep 23, 2025@20:28:22 Page 2
DGPTFN1 ;ISP/RFR - REGISTRATION EVENT NOTIFIER;Aug 24, 2020@16:27
+1 ;;5.3;Registration;**932,1020,1076**;Aug 13, 1993;Build 4
+2 ;
+3 QUIT
EN ;NOTIFY PACKAGES OF EVENT(S)
+1 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+2 WRITE @IOF
+3 WRITE !?19,"* * * REGISTRATION EVENT NOTIFIER * * *",!
End DoDot:1
+4 NEW NAME,NODE,DIC,X,EXIT,IEN,FILE,TYPES
+5 ;TYPES(DATA_NODE_NAME)=PROTOCOL_NAME
+6 SET TYPES("DG PTF ICD NOTIFIER")="DG PTF ICD DIAGNOSIS NOTIFIER"
+7 SET TYPES("DG PTF ICD OP NOTIFIER")="DG PTF ICD PROCEDURE NOTIFIER"
+8 SET TYPES("DG SA FILE ENTRY NOTIFIER")="DG SA FILE ENTRY NOTIFIER"
+9 SET NAME=""
FOR
SET NAME=$ORDER(TYPES(NAME))
if NAME=""!($GET(EXIT))
QUIT
Begin DoDot:1
+10 IF '$DATA(ZTQUEUED)
WRITE !,"PROCESSING "_NAME_" MESSAGES:",!
+11 IF '$DATA(^XTMP(NAME))!($ORDER(^XTMP(NAME,0))="")
Begin DoDot:2
+12 IF '$DATA(ZTQUEUED)
WRITE " THERE ARE NO DATA CHANGE MESSAGES TO PROCESS.",!
HANG 3
+13 IF $DATA(^XTMP(NAME))
KILL ^XTMP(NAME)
End DoDot:2
QUIT
+14 LOCK +^XTMP(NAME):DILOCKTM
+15 IF '$TEST
Begin DoDot:2
+16 IF '$DATA(ZTQUEUED)
WRITE !,"ANOTHER PROCESS IS ALREADY PROCESSING DATA CHANGE MESSAGES.",!
HANG 3
+17 SET EXIT=1
End DoDot:2
QUIT
+18 KILL ^TMP(NAME,$JOB)
+19 SET NODE=0
FOR
SET NODE=$ORDER(^XTMP(NAME,NODE))
if NODE=""
QUIT
Begin DoDot:2
+20 IF $EXTRACT(NODE,1)'?1N
WRITE " SKIPPING """_NODE_"""",!
QUIT
+21 IF '$DATA(ZTQUEUED)
WRITE " PROCESSING """_NODE_"""..."
+22 IF NAME="DG PTF ICD NOTIFIER"!(NAME="DG PTF ICD OP NOTIFIER")
Begin DoDot:3
+23 SET FILE=$GET(^XTMP(NAME,NODE,"FILE"))
+24 KILL ^XTMP(NAME,NODE,"FILE")
End DoDot:3
+25 MERGE ^TMP(NAME,$JOB)=^XTMP(NAME,NODE)
+26 SET DIC=101
SET X=TYPES(NAME)
+27 DO EN^XQOR
+28 IF NAME="DG PTF ICD NOTIFIER"!(NAME="DG PTF ICD OP NOTIFIER")
IF FILE'=""
Begin DoDot:3
+29 SET IEN=$GET(^XTMP(NAME,NODE,"IENS"))
SET IEN=$PIECE(IEN,",",$LENGTH(IEN,",")-1)
if IEN=""
QUIT
+30 KILL ^XTMP(NAME,"B",FILE,IEN)
End DoDot:3
+31 IF NAME="DG SA FILE ENTRY NOTIFIER CACHE"
Begin DoDot:3
+32 SET IEN=$GET(^XTMP(NAME,NODE,"IEN"))
if IEN=""
QUIT
+33 KILL ^XTMP(NAME,"B",IEN)
End DoDot:3
+34 KILL DIC,X,^TMP(NAME,$JOB),^XTMP(NAME,NODE)
+35 IF '$DATA(ZTQUEUED)
WRITE "DONE",!
End DoDot:2
+36 KILL ^XTMP(NAME)
+37 LOCK -^XTMP(NAME)
+38 WRITE "FINISHED PROCESSING "_NAME_" MESSAGES.",!
End DoDot:1
+39 IF '$DATA(ZTQUEUED)
WRITE !,"FINISHED PROCESSING ALL DATA CHANGE MESSAGES.",!
HANG 3
+40 QUIT
