Released DG*5.3*1076 SEQ #950 Extracted from mail message **KIDS**:DG*5.3*1076^ **INSTALL NAME** DG*5.3*1076 "BLD",12167,0) DG*5.3*1076^REGISTRATION^0^3220713^y "BLD",12167,1,0) ^^4^4^3220705^ "BLD",12167,1,1,0) This patch creates a new protocol that is executed whenever a field in "BLD",12167,1,2,0) the PTF (#45) file that points to the ICD PROCEDURE (#80.1) file is "BLD",12167,1,3,0) modified. See the associated patch description for complete details about "BLD",12167,1,4,0) this patch. "BLD",12167,4,0) ^9.64PA^^ "BLD",12167,6) 2 "BLD",12167,6.3) 4 "BLD",12167,"ABPKG") n "BLD",12167,"INIT") POST^DG531076P "BLD",12167,"KRN",0) ^9.67PA^1.5^25 "BLD",12167,"KRN",.4,0) .4 "BLD",12167,"KRN",.401,0) .401 "BLD",12167,"KRN",.402,0) .402 "BLD",12167,"KRN",.403,0) .403 "BLD",12167,"KRN",.5,0) .5 "BLD",12167,"KRN",.84,0) .84 "BLD",12167,"KRN",1.5,0) 1.5 "BLD",12167,"KRN",1.6,0) 1.6 "BLD",12167,"KRN",1.61,0) 1.61 "BLD",12167,"KRN",1.62,0) 1.62 "BLD",12167,"KRN",3.6,0) 3.6 "BLD",12167,"KRN",3.8,0) 3.8 "BLD",12167,"KRN",9.2,0) 9.2 "BLD",12167,"KRN",9.8,0) 9.8 "BLD",12167,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12167,"KRN",9.8,"NM",1,0) DGPTDD^^0^B71124651 "BLD",12167,"KRN",9.8,"NM",2,0) DGPTFN1^^0^B5228879 "BLD",12167,"KRN",9.8,"NM","B","DGPTDD",1) "BLD",12167,"KRN",9.8,"NM","B","DGPTFN1",2) "BLD",12167,"KRN",19,0) 19 "BLD",12167,"KRN",19.1,0) 19.1 "BLD",12167,"KRN",101,0) 101 "BLD",12167,"KRN",101,"NM",0) ^9.68A^1^1 "BLD",12167,"KRN",101,"NM",1,0) DG PTF ICD PROCEDURE NOTIFIER^^0 "BLD",12167,"KRN",101,"NM","B","DG PTF ICD PROCEDURE NOTIFIER",1) "BLD",12167,"KRN",409.61,0) 409.61 "BLD",12167,"KRN",771,0) 771 "BLD",12167,"KRN",779.2,0) 779.2 "BLD",12167,"KRN",870,0) 870 "BLD",12167,"KRN",8989.51,0) 8989.51 "BLD",12167,"KRN",8989.52,0) 8989.52 "BLD",12167,"KRN",8993,0) 8993 "BLD",12167,"KRN",8994,0) 8994 "BLD",12167,"KRN","B",.4,.4) "BLD",12167,"KRN","B",.401,.401) "BLD",12167,"KRN","B",.402,.402) "BLD",12167,"KRN","B",.403,.403) "BLD",12167,"KRN","B",.5,.5) "BLD",12167,"KRN","B",.84,.84) "BLD",12167,"KRN","B",1.5,1.5) "BLD",12167,"KRN","B",1.6,1.6) "BLD",12167,"KRN","B",1.61,1.61) "BLD",12167,"KRN","B",1.62,1.62) "BLD",12167,"KRN","B",3.6,3.6) "BLD",12167,"KRN","B",3.8,3.8) "BLD",12167,"KRN","B",9.2,9.2) "BLD",12167,"KRN","B",9.8,9.8) "BLD",12167,"KRN","B",19,19) "BLD",12167,"KRN","B",19.1,19.1) "BLD",12167,"KRN","B",101,101) "BLD",12167,"KRN","B",409.61,409.61) "BLD",12167,"KRN","B",771,771) "BLD",12167,"KRN","B",779.2,779.2) "BLD",12167,"KRN","B",870,870) "BLD",12167,"KRN","B",8989.51,8989.51) "BLD",12167,"KRN","B",8989.52,8989.52) "BLD",12167,"KRN","B",8993,8993) "BLD",12167,"KRN","B",8994,8994) "BLD",12167,"QUES",0) ^9.62^^ "BLD",12167,"REQB",0) ^9.611^1^1 "BLD",12167,"REQB",1,0) DG*5.3*1020^2 "BLD",12167,"REQB","B","DG*5.3*1020",1) "INIT") POST^DG531076P "KRN",101,6880,-1) 0^1 "KRN",101,6880,0) DG PTF ICD PROCEDURE NOTIFIER^ICD PROCEDURE CODE NOTIFIER^^X^^^^^^^^REGISTRATION "KRN",101,6880,1,0) ^101.06^43^43^3220609^^ "KRN",101,6880,1,1,0) This protocol will notify subscribing packages when an International "KRN",101,6880,1,2,0) Classification of Diseases (ICD) procedure code is added, modified or "KRN",101,6880,1,3,0) removed for entries within the PTF file (#45). "KRN",101,6880,1,4,0) "KRN",101,6880,1,5,0) The following data is available to subscribers: "KRN",101,6880,1,6,0) "KRN",101,6880,1,7,0) ^TMP("DG PTF ICD OP NOTIFIER",$J,"DATE")=DATE "KRN",101,6880,1,8,0) DATE: FileMan date/time (internal format) of when the activity occurred. "KRN",101,6880,1,9,0) "KRN",101,6880,1,10,0) ^TMP("DG PTF ICD OP NOTIFIER",$J,"DFN")=DFN "KRN",101,6880,1,11,0) DFN: internal entry number of the patient in the PATIENT file (#2). "KRN",101,6880,1,12,0) "KRN",101,6880,1,13,0) ^TMP("DG PTF ICD OP NOTIFIER",$J,TYPE,"IENS")=IENS "KRN",101,6880,1,14,0) TYPE: The activity type; possible values are "DISCHARGE", "PROCEDURE", "KRN",101,6880,1,15,0) and "SURGERY". "DISCHARGE" codes are from the PROCEDURE series of "KRN",101,6880,1,16,0) fields on the 401P node in the PTF (#45) file. "KRN",101,6880,1,17,0) "PROCEDURE" codes are from the PROCEDURE CODE series of fields "KRN",101,6880,1,18,0) in the 601 sub-file (#45.05) of the PTF file (#45). "SURGERY" codes "KRN",101,6880,1,19,0) are from the OPERATION CODE series of fields in the 401 sub-file "KRN",101,6880,1,20,0) (#45.01) of the PTF (#45) file. "KRN",101,6880,1,21,0) IENS: The internal entry number string identifying the record in which "KRN",101,6880,1,22,0) the associated codes are stored. "KRN",101,6880,1,23,0) "KRN",101,6880,1,24,0) ^TMP("DG PTF ICD OP NOTIFIER",$J,TYPE,FIELD,"OLD")=ICDP "KRN",101,6880,1,25,0) This is how the field appeared in the file before the change was made. "KRN",101,6880,1,26,0) FIELD: This is an abbreviation denoting which field the code came from. "KRN",101,6880,1,27,0) The following table should assist in determining which field a "KRN",101,6880,1,28,0) code came from: "KRN",101,6880,1,29,0) TYPE FIELD Field Name "KRN",101,6880,1,30,0) ----------------------------------------------------- "KRN",101,6880,1,31,0) DISCHARGE OPCnn PROCEDURE nn (nn is a whole number) "KRN",101,6880,1,32,0) PROCEDURE OPCnn PROCEDURE CODE nn (nn is a whole number) "KRN",101,6880,1,33,0) SURGERY OPCnn OPERATION CODE nn (nn is a whole number) "KRN",101,6880,1,34,0) ICDP: Internal entry number of the procedure code in the ICD OPERATION/ "KRN",101,6880,1,35,0) PROCEDURE file (#80.1). "KRN",101,6880,1,36,0) "KRN",101,6880,1,37,0) ^TMP("DG PTF ICD OP NOTIFIER",$J,TYPE,FIELD,"NEW")=ICDP "KRN",101,6880,1,38,0) This is how the field appeared in the file after the change was made. "KRN",101,6880,1,39,0) "KRN",101,6880,1,40,0) When a code is added, the "OLD" value will be blank and the "NEW" value "KRN",101,6880,1,41,0) will not be. When a code is deleted, the "OLD" value will not be blank and "KRN",101,6880,1,42,0) the "NEW" value will be. When a code is changed, both the "OLD" and "NEW" "KRN",101,6880,1,43,0) values will not be blank. "KRN",101,6880,10,0) ^101.01PA^1^1 "KRN",101,6880,99) 66263,55787 "MBREQ") 0 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "PKG",114,-1) 1^1 "PKG",114,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",114,22,0) ^9.49I^1^1 "PKG",114,22,1,0) 5.3^2930813^2930821 "PKG",114,22,1,"PAH",1,0) 1076^3220713 "PKG",114,22,1,"PAH",1,1,0) ^^4^4^3220713 "PKG",114,22,1,"PAH",1,1,1,0) This patch creates a new protocol that is executed whenever a field in "PKG",114,22,1,"PAH",1,1,2,0) the PTF (#45) file that points to the ICD PROCEDURE (#80.1) file is "PKG",114,22,1,"PAH",1,1,3,0) modified. See the associated patch description for complete details about "PKG",114,22,1,"PAH",1,1,4,0) this patch. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","DG531076P") 0^^B13354282^n/a "RTN","DG531076P",1,0) DG531076P ;ISP/RFR - PATCH 1076 POST-INIT;May 21, 2018@16:23 "RTN","DG531076P",2,0) ;;5.3;Registration;**1076**;Aug 13, 1993;Build 4 "RTN","DG531076P",3,0) ; "RTN","DG531076P",4,0) POST ; -- post init to build xrefs "RTN","DG531076P",5,0) D BMES^XPDUTL(" Creating new-style indexes in the PTF (#45) file...") "RTN","DG531076P",6,0) D TOP "RTN","DG531076P",7,0) D 601 "RTN","DG531076P",8,0) D 401 "RTN","DG531076P",9,0) Q "RTN","DG531076P",10,0) ; "RTN","DG531076P",11,0) TOP ; -- AICP index on 401P node fields "RTN","DG531076P",12,0) N DGPTXR,DGPTRES,DGPTOUT,X "RTN","DG531076P",13,0) S DGPTXR("FILE")=45 "RTN","DG531076P",14,0) S DGPTXR("NAME")="AICP" "RTN","DG531076P",15,0) S DGPTXR("TYPE")="MU" "RTN","DG531076P",16,0) S DGPTXR("USE")="A" "RTN","DG531076P",17,0) S DGPTXR("EXECUTION")="R" "RTN","DG531076P",18,0) S DGPTXR("SHORT DESCR")="Notify packages of ICD procedure code change." "RTN","DG531076P",19,0) S DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol" "RTN","DG531076P",20,0) S DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added," "RTN","DG531076P",21,0) S DGPTXR("DESCR",3)="edited, or removed." "RTN","DG531076P",22,0) S DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""DISCHARGE"",""SET"")" "RTN","DG531076P",23,0) S DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""DISCHARGE"",""KILL"")" "RTN","DG531076P",24,0) S DGPTXR("WHOLE KILL")="Q" "RTN","DG531076P",25,0) S DGPTXR("VAL",1)=.01 ;Patient "RTN","DG531076P",26,0) S DGPTXR("VAL",2)=11 ;Type of Record "RTN","DG531076P",27,0) S DGPTXR("VAL",3)=45.01 ;Procedure n "RTN","DG531076P",28,0) S DGPTXR("VAL",4)=45.02 "RTN","DG531076P",29,0) S DGPTXR("VAL",5)=45.03 "RTN","DG531076P",30,0) S DGPTXR("VAL",6)=45.04 "RTN","DG531076P",31,0) S DGPTXR("VAL",7)=45.05 "RTN","DG531076P",32,0) D CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT") "RTN","DG531076P",33,0) S X=" AICP: "_$S(+$G(DGPTRES):"DONE",1:"FAILED") "RTN","DG531076P",34,0) D MES^XPDUTL(X) "RTN","DG531076P",35,0) Q "RTN","DG531076P",36,0) ; "RTN","DG531076P",37,0) 601 ; -- AICPP index on 601 multiple "RTN","DG531076P",38,0) N DGPTXR,DGPTRES,DGPTOUT,I "RTN","DG531076P",39,0) S DGPTXR("FILE")=45.05 "RTN","DG531076P",40,0) S DGPTXR("NAME")="AICPP" "RTN","DG531076P",41,0) S DGPTXR("TYPE")="MU" "RTN","DG531076P",42,0) S DGPTXR("USE")="A" "RTN","DG531076P",43,0) S DGPTXR("EXECUTION")="R",DGPTXR("ACTIVITY")="" "RTN","DG531076P",44,0) S DGPTXR("SHORT DESCR")="Notify packages of ICD procedure code change." "RTN","DG531076P",45,0) S DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol" "RTN","DG531076P",46,0) S DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added," "RTN","DG531076P",47,0) S DGPTXR("DESCR",3)="edited, or removed." "RTN","DG531076P",48,0) S DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""PROCEDURE"",""SET"")" "RTN","DG531076P",49,0) S DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""PROCEDURE"",""KILL"")" "RTN","DG531076P",50,0) S DGPTXR("WHOLE KILL")="Q" "RTN","DG531076P",51,0) S DGPTXR("VAL",1)=.01 "RTN","DG531076P",52,0) ; Procedure Codes 1-25 "RTN","DG531076P",53,0) F I=2:1:26 S DGPTXR("VAL",I)=I+2 "RTN","DG531076P",54,0) D CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT") "RTN","DG531076P",55,0) S X=" AICPP: "_$S(+$G(DGPTRES):"DONE",1:"FAILED") "RTN","DG531076P",56,0) D MES^XPDUTL(X) "RTN","DG531076P",57,0) Q "RTN","DG531076P",58,0) ; "RTN","DG531076P",59,0) 401 ; -- AICPS index on 401 multiple "RTN","DG531076P",60,0) N DGPTXR,DGPTRES,DGPTOUT,I "RTN","DG531076P",61,0) S DGPTXR("FILE")=45.01 "RTN","DG531076P",62,0) S DGPTXR("NAME")="AICPS" "RTN","DG531076P",63,0) S DGPTXR("TYPE")="MU" "RTN","DG531076P",64,0) S DGPTXR("USE")="A" "RTN","DG531076P",65,0) S DGPTXR("EXECUTION")="R",DGPTXR("ACTIVITY")="" "RTN","DG531076P",66,0) S DGPTXR("SHORT DESCR")="Notify packages of ICD diagnosis code change." "RTN","DG531076P",67,0) S DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol" "RTN","DG531076P",68,0) S DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added," "RTN","DG531076P",69,0) S DGPTXR("DESCR",3)="edited, or removed." "RTN","DG531076P",70,0) S DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""SURGERY"",""SET"")" "RTN","DG531076P",71,0) S DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""SURGERY"",""KILL"")" "RTN","DG531076P",72,0) S DGPTXR("WHOLE KILL")="Q" "RTN","DG531076P",73,0) S DGPTXR("VAL",1)=.01 "RTN","DG531076P",74,0) ; Operation Codes 1-25 "RTN","DG531076P",75,0) F I=2:1:26 S DGPTXR("VAL",I)=I+6 "RTN","DG531076P",76,0) D CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT") "RTN","DG531076P",77,0) S X=" AICPS: "_$S(+$G(DGPTRES):"DONE",1:"FAILED") "RTN","DG531076P",78,0) D MES^XPDUTL(X) "RTN","DG531076P",79,0) Q "RTN","DGPTDD") 0^1^B71124651^B39782335 "RTN","DGPTDD",1,0) DGPTDD ;ALB/LD - DD CALLS FOR PTF (#45) FILE;Nov 20, 2020@09:44 "RTN","DGPTDD",2,0) ;;5.3;Registration;**58,932,1020,1076**;Aug 13, 1993;Build 4 "RTN","DGPTDD",3,0) ; "RTN","DGPTDD",4,0) ; DD calls for the Suffix and Transferring Suffix fields of PTF "RTN","DGPTDD",5,0) ; file (#45). "RTN","DGPTDD",6,0) ; "RTN","DGPTDD",7,0) ACTIVE(X,Y,DGADM) ; Suffix active during patient's admission date? "RTN","DGPTDD",8,0) ; "RTN","DGPTDD",9,0) ; DGEFDT -- Suffix Effective Date "RTN","DGPTDD",10,0) ; DGEFIEN -- Suffix Effective Date IEN "RTN","DGPTDD",11,0) ; DGSUFPTR -- Suffix pointer from Station Type file "RTN","DGPTDD",12,0) ; "RTN","DGPTDD",13,0) ; INPUT: X -- Suffix "RTN","DGPTDD",14,0) ; Y -- Station Type Number "RTN","DGPTDD",15,0) ; DGADM -- PTF IEN (use to get 2nd piece which is "RTN","DGPTDD",16,0) ; admission date or use DT if null) "RTN","DGPTDD",17,0) ; OUTPUT: DGACT -- Active during admission date? (1=YES,0=NO) "RTN","DGPTDD",18,0) ; "RTN","DGPTDD",19,0) N DGACT,DGEFDT,DGEFIEN,DGFL,DGSUFPTR,DGI "RTN","DGPTDD",20,0) S (DGACT,DGEFIEN,DGEFDT,DGFL,DGSUFPTR)=0 "RTN","DGPTDD",21,0) F DGI=0:0 S DGI=$O(^DIC(45.81,+$G(Y),"S","B",DGI)) Q:'DGI!$G(DGFL) D "RTN","DGPTDD",22,0) .I $P($G(^DIC(45.68,DGI,0)),U)=$G(X) S DGSUFPTR=DGI,DGFL=1 "RTN","DGPTDD",23,0) I $D(^DGPT(+$G(DGADM),0)) S DGADM=+$P(^(0),U,2) "RTN","DGPTDD",24,0) S DGADM=$S(+$G(DGADM)>0:-DGADM,1:-DT) S:$P(DGADM,".",2) DGADM=$P(DGADM,".") S DGADM=DGADM_.2359 "RTN","DGPTDD",25,0) S DGEFDT=+$O(^DIC(45.68,DGSUFPTR,"E","AEFF",DGADM)) "RTN","DGPTDD",26,0) I -(DGEFDT)'>0 S DGEFDT=+$O(^DIC(45.68,DGSUFPTR,"E","B",DGEFDT)),DGEFDT=-DGEFDT "RTN","DGPTDD",27,0) S DGEFIEN=$O(^DIC(45.68,DGSUFPTR,"E","AEFF",DGEFDT,DGEFIEN)) "RTN","DGPTDD",28,0) S DGACT=$P($G(^DIC(45.68,+DGSUFPTR,"E",+DGEFIEN,0)),U,2) "RTN","DGPTDD",29,0) Q +$G(DGACT) "RTN","DGPTDD",30,0) ; "RTN","DGPTDD",31,0) ACTLST(DGADM) ; List of active suffixes "RTN","DGPTDD",32,0) ; "RTN","DGPTDD",33,0) ; DGEFFDT -- Suffix Effective Date "RTN","DGPTDD",34,0) ; DGEFFIEN -- Suffix Effective Date IEN "RTN","DGPTDD",35,0) ; "RTN","DGPTDD",36,0) ; INPUT: DGADM -- PTF IEN (use to get 2nd piece which is "RTN","DGPTDD",37,0) ; admission date or use DT if null) "RTN","DGPTDD",38,0) ; OUTPUT: List of active suffixes during admission date "RTN","DGPTDD",39,0) ; "RTN","DGPTDD",40,0) N DGCTR,DGEFFDT,DGEFFIEN,DGI,DGOUT,DGST,DGX,DGY "RTN","DGPTDD",41,0) S (DGEFFDT,DGOUT)=0,DGCTR=1 "RTN","DGPTDD",42,0) I $D(^DGPT(+$G(DGADM),0)) S DGADM=+$P(^(0),U,2) "RTN","DGPTDD",43,0) S DGADM=$S(+$G(DGADM)>0:-DGADM,1:-DT) S:$P(DGADM,".",2) DGADM=$P(DGADM,".") "RTN","DGPTDD",44,0) F DGST=0:0 S DGST=$O(^DIC(45.81,"B",DGST)) Q:'DGST D "RTN","DGPTDD",45,0) .F DGI=0:0 S DGI=$O(^DIC(45.81,DGST,"S","B",DGI)) Q:'DGI D "RTN","DGPTDD",46,0) ..S DGEFFDT=+$O(^DIC(45.68,DGI,"E","AEFF",DGADM)) "RTN","DGPTDD",47,0) ..I -(DGEFFDT)'>0 S DGEFFDT=$O(^DIC(45.68,DGI,"E","B",DGEFFDT)),DGEFFDT=-DGEFFDT "RTN","DGPTDD",48,0) ..S DGEFFIEN=0,DGEFFIEN=$O(^DIC(45.68,DGI,"E","AEFF",DGEFFDT,DGEFFIEN)) "RTN","DGPTDD",49,0) ..S:$P($G(^DIC(45.68,DGI,"E",+DGEFFIEN,0)),U,2)=1 ^TMP("ACTSUFF",$J,DGCTR)=$P($G(^DIC(45.68,DGI,0)),U)_U_$P($G(^DIC(45.81,DGST,0)),U,2),DGCTR=DGCTR+1 "RTN","DGPTDD",50,0) W @IOF,"Choose From:",! "RTN","DGPTDD",51,0) F DGX=0:0 S DGX=$O(^TMP("ACTSUFF",$J,DGX)) Q:'DGX!($G(DGOUT)) D "RTN","DGPTDD",52,0) .I $Y>(IOSL-5) D NEXTSCR "RTN","DGPTDD",53,0) .W:'$G(DGOUT) !,$P($G(^TMP("ACTSUFF",$J,DGX)),U),?15,$P($G(^TMP("ACTSUFF",$J,DGX)),U,2) "RTN","DGPTDD",54,0) K ^TMP("ACTSUFF") "RTN","DGPTDD",55,0) Q "RTN","DGPTDD",56,0) NEXTSCR ; "RTN","DGPTDD",57,0) F DGY=$Y:1:(IOSL-4) W ! "RTN","DGPTDD",58,0) S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S DGOUT=1 K DIRUT,DTOUT,DUOUT G NEXTSCRQ "RTN","DGPTDD",59,0) W @IOF,"Choose From:",! "RTN","DGPTDD",60,0) NEXTSCRQ ; "RTN","DGPTDD",61,0) Q "RTN","DGPTDD",62,0) ;============================================= "RTN","DGPTDD",63,0) ;QUEUE DATA CHANGE MESSAGES WHEN AN ICD "RTN","DGPTDD",64,0) ;DIAGNOSIS CODE IS RECORDED, EDITED OR DELETED "RTN","DGPTDD",65,0) NOTIFY(OLDVAL,NEWVAL,DA,FILE,TYPE,ACTION) ; "RTN","DGPTDD",66,0) ;ALLOW THE SET CALL TO STORE THE DATA WHEN EDITING AN ENTRY "RTN","DGPTDD",67,0) ;DO NOT EXECUTE DURING A PRE-/POST-INSTALL OF THE RELATED INDEXES "RTN","DGPTDD",68,0) I (($G(ACTION)="KILL")&($G(NEWVAL(1))'=""))!($G(XPDNM)'="") Q "RTN","DGPTDD",69,0) N IEN,DFN,RECTYPE,SUB,NAME,NODE,EXISTS,FIELD,GTYPE,CLEAR,STATION,VAIN,VAERR "RTN","DGPTDD",70,0) N INST "RTN","DGPTDD",71,0) S IEN=$$IENS^DILF(.DA) Q:+IEN<1 "RTN","DGPTDD",72,0) S IEN("TOP")=$P(IEN,",",$L(IEN,",")-1),TYPE=$G(TYPE) "RTN","DGPTDD",73,0) I TYPE="DISCHARGE" S DFN=$G(NEWVAL(1)),RECTYPE=$G(NEWVAL(2)),SUB=2 "RTN","DGPTDD",74,0) I (TYPE="MOVEMENT")!(TYPE="SERVICE") D "RTN","DGPTDD",75,0) .S DFN=$P($G(^DGPT(IEN("TOP"),0)),U) "RTN","DGPTDD",76,0) .S RECTYPE=$P($G(^DGPT(IEN("TOP"),0)),U,11),SUB=1 "RTN","DGPTDD",77,0) .I TYPE="MOVEMENT" Q "RTN","DGPTDD",78,0) .I +$G(OLDVAL(3))=0,$G(NEWVAL(3))=1 S CLEAR="NEWVAL" "RTN","DGPTDD",79,0) .I $G(OLDVAL(3))=1,+$G(NEWVAL(3))=0,'$$ALLCLEAR(.NEWVAL) S CLEAR="OLDVAL" "RTN","DGPTDD",80,0) .I $G(CLEAR)'="" D "RTN","DGPTDD",81,0) ..F S SUB=$O(@CLEAR@(SUB)) Q:'+SUB S @CLEAR@(SUB)="" "RTN","DGPTDD",82,0) ..S SUB=0 "RTN","DGPTDD",83,0) ..K CLEAR "RTN","DGPTDD",84,0) .K OLDVAL(3),NEWVAL(3) "RTN","DGPTDD",85,0) I TYPE="SERVICE46",$G(NEWVAL(2))>0 D "RTN","DGPTDD",86,0) .S DFN=$P($G(^DGPT(NEWVAL(2),0)),U) "RTN","DGPTDD",87,0) .S RECTYPE=$P($G(^DGPT(NEWVAL(2),0)),U,11),SUB=2,IEN("TOP")=NEWVAL(2) "RTN","DGPTDD",88,0) .I $G(OLDVAL(11))="",$G(NEWVAL(11))>0 S CLEAR="NEWVAL" "RTN","DGPTDD",89,0) .I $G(OLDVAL(11))>0,$G(NEWVAL(11))="",'$$ALLCLEAR(.NEWVAL) S CLEAR="OLDVAL" "RTN","DGPTDD",90,0) .I $G(CLEAR)'="" D "RTN","DGPTDD",91,0) ..F S SUB=$O(@CLEAR@(SUB)) Q:'+SUB S @CLEAR@(SUB)="" "RTN","DGPTDD",92,0) ..S SUB=1 "RTN","DGPTDD",93,0) ..K CLEAR "RTN","DGPTDD",94,0) .K OLDVAL(11),NEWVAL(11) "RTN","DGPTDD",95,0) ;SKIP UNKNOWN TYPE AND CENSUS RECORDS (RECTYPE=2) "RTN","DGPTDD",96,0) I (+$G(DFN)<1)!($G(RECTYPE)="")!($G(RECTYPE)=2)!('$D(SUB)) Q "RTN","DGPTDD",97,0) S NAME="DG PTF ICD NOTIFIER",NODE=$$GETNODE(NAME,FILE,IEN("TOP")) "RTN","DGPTDD",98,0) F S SUB=$O(OLDVAL(SUB)) Q:'+SUB D "RTN","DGPTDD",99,0) .I OLDVAL(SUB)=NEWVAL(SUB) Q "RTN","DGPTDD",100,0) .S FIELD=$$GETFIELD(TYPE,SUB) Q:FIELD="" "RTN","DGPTDD",101,0) .S EXISTS=$D(^XTMP(NAME,NODE,TYPE,FIELD)) "RTN","DGPTDD",102,0) .S EXISTS("NEW")=$G(^XTMP(NAME,NODE,TYPE,FIELD,"NEW")) "RTN","DGPTDD",103,0) .S EXISTS("OLD")=$G(^XTMP(NAME,NODE,TYPE,FIELD,"OLD")) "RTN","DGPTDD",104,0) .;NEW RECORD/FIELD VALUE DELETED BEFORE NOTIFICATION SENT "RTN","DGPTDD",105,0) .I EXISTS,EXISTS("NEW")=$G(OLDVAL(SUB)),$G(NEWVAL(SUB))="",EXISTS("OLD")="" D Q "RTN","DGPTDD",106,0) ..K ^XTMP(NAME,NODE,TYPE,FIELD) "RTN","DGPTDD",107,0) .I 'EXISTS S ^XTMP(NAME,NODE,TYPE,FIELD,"OLD")=$G(OLDVAL(SUB)) "RTN","DGPTDD",108,0) .S ^XTMP(NAME,NODE,TYPE,FIELD,"NEW")=$G(NEWVAL(SUB)) "RTN","DGPTDD",109,0) S CLEAR=1,CLEAR("ALL")=1 "RTN","DGPTDD",110,0) F GTYPE="DISCHARGE","MOVEMENT","SERVICE","SERVICE46" D "RTN","DGPTDD",111,0) .I $D(^XTMP(NAME,NODE,GTYPE)) D "RTN","DGPTDD",112,0) ..S SUB="" F S SUB=$O(^XTMP(NAME,NODE,GTYPE,SUB)) Q:SUB=""!('CLEAR) D "RTN","DGPTDD",113,0) ...I SUB'="IENS" S CLEAR=0,CLEAR("ALL")=0 "RTN","DGPTDD",114,0) ..I CLEAR K ^XTMP(NAME,NODE,GTYPE) "RTN","DGPTDD",115,0) ..E S CLEAR=1 "RTN","DGPTDD",116,0) I CLEAR("ALL") D Q "RTN","DGPTDD",117,0) .K ^XTMP(NAME,NODE),^XTMP(NAME,"B",FILE,IEN("TOP")) "RTN","DGPTDD",118,0) .I $O(^XTMP(NAME,0))="" K ^XTMP(NAME) "RTN","DGPTDD",119,0) S ^XTMP(NAME,NODE,TYPE,"IENS")=IEN "RTN","DGPTDD",120,0) S ^XTMP(NAME,NODE,"DFN")=DFN "RTN","DGPTDD",121,0) S ^XTMP(NAME,NODE,"INTEREST DATE")=$P($G(^DGPT(IEN("TOP"),0)),U,2) "RTN","DGPTDD",122,0) S ^XTMP(NAME,NODE,"OCCURRED DATE")=$$NOW^XLFDT "RTN","DGPTDD",123,0) S ^XTMP(NAME,NODE,"FILE")=FILE "RTN","DGPTDD",124,0) D INP^VADPT "RTN","DGPTDD",125,0) Q:+$G(VAERR) "RTN","DGPTDD",126,0) I +$G(VAIN(2))>0 S ^XTMP(NAME,NODE,"PRIMARY PROVIDER")=+VAIN(2) "RTN","DGPTDD",127,0) I +$G(VAIN(11))>0 S ^XTMP(NAME,NODE,"ATTENDING PHYSICIAN")=+VAIN(11) "RTN","DGPTDD",128,0) I +$G(VAIN(4))>0 D "RTN","DGPTDD",129,0) .S INST=+$P($G(^DIC(42,+VAIN(4),0)),U,11) Q:INST=0 "RTN","DGPTDD",130,0) .S INST=+$P($G(^DG(40.8,INST,0)),U,7) Q:INST=0 "RTN","DGPTDD",131,0) I +$G(VAIN(4))=0 D "RTN","DGPTDD",132,0) .S INST=+$P($G(^DGPT(IEN("TOP"),0)),U,3) Q:INST=0 "RTN","DGPTDD",133,0) .D F4^XUAF4(INST,.STATION) Q:$P($G(STATION),U,1)=0 "RTN","DGPTDD",134,0) .S INST=$P(STATION,U,1) "RTN","DGPTDD",135,0) I +$G(INST)>0 S ^XTMP(NAME,NODE,"INSTITUTION")=INST "RTN","DGPTDD",136,0) S ^XTMP(NAME,"B",FILE,IEN("TOP"))=NODE "RTN","DGPTDD",137,0) Q "RTN","DGPTDD",138,0) ALLCLEAR(DATA) ;RETURN TRUE IF ALL NODES ARE EMPTY "RTN","DGPTDD",139,0) N RETURN,SUB "RTN","DGPTDD",140,0) S RETURN=1 "RTN","DGPTDD",141,0) S SUB="" F S SUB=$O(DATA(SUB)) Q:(SUB="")!('RETURN) D "RTN","DGPTDD",142,0) .I $G(DATA(SUB))'="" S RETURN=0 "RTN","DGPTDD",143,0) Q RETURN "RTN","DGPTDD",144,0) GETNODE(NAME,FILE,IEN) ;RETURN A FREE NODE IN NOTIFIER DATA "RTN","DGPTDD",145,0) N RETURN "RTN","DGPTDD",146,0) S RETURN=$G(^XTMP(NAME,"B",FILE,IEN)) "RTN","DGPTDD",147,0) I RETURN="" F S RETURN=$J_" "_$$NOW^XLFDT Q:'$D(^XTMP(NAME,RETURN)) H 1 "RTN","DGPTDD",148,0) S ^XTMP(NAME,0)=$$FMADD^XLFDT(DT,5)_U_DT_U_"PTF ICD NOTIFIER DATA" "RTN","DGPTDD",149,0) Q RETURN "RTN","DGPTDD",150,0) GETFIELD(TYPE,SUB) ;RETURN SUBSCRIPT FIELD NAME "RTN","DGPTDD",151,0) N RETURN,NUMBER "RTN","DGPTDD",152,0) S RETURN="" "RTN","DGPTDD",153,0) I TYPE="DISCHARGE" D "RTN","DGPTDD",154,0) .I SUB=3 S RETURN="PDX" Q "RTN","DGPTDD",155,0) .I SUB>3,SUB<28 S NUMBER=SUB-3,RETURN="SDX"_$S(NUMBER<10:"0",1:"")_NUMBER Q "RTN","DGPTDD",156,0) .I SUB=28 S RETURN="PDX-P1986" "RTN","DGPTDD",157,0) I TYPE="MOVEMENT" D "RTN","DGPTDD",158,0) .I SUB>1,SUB<27 S NUMBER=SUB-1,RETURN="DX"_$S(NUMBER<10:"0",1:"")_NUMBER "RTN","DGPTDD",159,0) I TYPE="SERVICE",SUB=2 S RETURN="PDX" "RTN","DGPTDD",160,0) I TYPE="SERVICE46" D "RTN","DGPTDD",161,0) .I SUB=3 S RETURN="PDX" Q "RTN","DGPTDD",162,0) .I SUB>3,SUB<11 S NUMBER=SUB-3,RETURN="SDX"_$S(NUMBER<10:"0",1:"")_NUMBER "RTN","DGPTDD",163,0) Q RETURN "RTN","DGPTDD",164,0) ; "RTN","DGPTDD",165,0) ;============================================= "RTN","DGPTDD",166,0) ;QUEUE DATA CHANGE MESSAGES WHEN AN ICD "RTN","DGPTDD",167,0) ;PROCEDURE CODE IS RECORDED, EDITED OR DELETED "RTN","DGPTDD",168,0) NOTIFYP(OLDVAL,NEWVAL,DA,FILE,TYPE,ACTION) ; "RTN","DGPTDD",169,0) ;ALLOW THE SET CALL TO STORE THE DATA WHEN EDITING AN ENTRY "RTN","DGPTDD",170,0) ;DO NOT EXECUTE DURING A PRE-/POST-INSTALL OF THE RELATED INDEXES "RTN","DGPTDD",171,0) I (($G(ACTION)="KILL")&($G(NEWVAL(1))'=""))!($G(XPDNM)'="") Q "RTN","DGPTDD",172,0) N IEN,DFN,RECTYPE,SUB,NAME,NODE,EXISTS,FIELD,GTYPE,CLEAR,STATION,INST "RTN","DGPTDD",173,0) S IEN=$$IENS^DILF(.DA) Q:+IEN<1 "RTN","DGPTDD",174,0) S IEN("TOP")=$P(IEN,",",$L(IEN,",")-1),TYPE=$G(TYPE) "RTN","DGPTDD",175,0) I TYPE="DISCHARGE" S DFN=$G(NEWVAL(1)),RECTYPE=$G(NEWVAL(2)),SUB=2 "RTN","DGPTDD",176,0) I (TYPE="PROCEDURE")!(TYPE="SURGERY") D "RTN","DGPTDD",177,0) . S DFN=$P($G(^DGPT(IEN("TOP"),0)),U) "RTN","DGPTDD",178,0) . S RECTYPE=$P($G(^DGPT(IEN("TOP"),0)),U,11),SUB=1 "RTN","DGPTDD",179,0) ; SKIP UNKNOWN TYPE AND CENSUS RECORDS (RECTYPE=2) "RTN","DGPTDD",180,0) I (+$G(DFN)<1)!($G(RECTYPE)="")!($G(RECTYPE)=2)!('$D(SUB)) Q "RTN","DGPTDD",181,0) ; "RTN","DGPTDD",182,0) S NAME="DG PTF ICD OP NOTIFIER",NODE=$$GETNODE(NAME,FILE,IEN("TOP")) "RTN","DGPTDD",183,0) F S SUB=$O(OLDVAL(SUB)) Q:'+SUB D "RTN","DGPTDD",184,0) . I OLDVAL(SUB)=NEWVAL(SUB) Q "RTN","DGPTDD",185,0) . S FIELD=$$GETFLD(TYPE,SUB) Q:FIELD="" "RTN","DGPTDD",186,0) . S EXISTS=$D(^XTMP(NAME,NODE,TYPE,FIELD)) "RTN","DGPTDD",187,0) . S EXISTS("NEW")=$G(^XTMP(NAME,NODE,TYPE,FIELD,"NEW")) "RTN","DGPTDD",188,0) . S EXISTS("OLD")=$G(^XTMP(NAME,NODE,TYPE,FIELD,"OLD")) "RTN","DGPTDD",189,0) . ;NEW RECORD/FIELD VALUE DELETED BEFORE NOTIFICATION SENT "RTN","DGPTDD",190,0) . I EXISTS,EXISTS("NEW")=$G(OLDVAL(SUB)),$G(NEWVAL(SUB))="",EXISTS("OLD")="" D Q "RTN","DGPTDD",191,0) .. K ^XTMP(NAME,NODE,TYPE,FIELD) "RTN","DGPTDD",192,0) . I 'EXISTS S ^XTMP(NAME,NODE,TYPE,FIELD,"OLD")=$G(OLDVAL(SUB)) "RTN","DGPTDD",193,0) . S ^XTMP(NAME,NODE,TYPE,FIELD,"NEW")=$G(NEWVAL(SUB)) "RTN","DGPTDD",194,0) ; "RTN","DGPTDD",195,0) S CLEAR=1,CLEAR("ALL")=1 "RTN","DGPTDD",196,0) F GTYPE="DISCHARGE","PROCEDURE","SURGERY" D "RTN","DGPTDD",197,0) . I $D(^XTMP(NAME,NODE,GTYPE)) D "RTN","DGPTDD",198,0) .. S SUB="" F S SUB=$O(^XTMP(NAME,NODE,GTYPE,SUB)) Q:SUB=""!('CLEAR) D "RTN","DGPTDD",199,0) ... I SUB'="IENS" S CLEAR=0,CLEAR("ALL")=0 "RTN","DGPTDD",200,0) .. I CLEAR K ^XTMP(NAME,NODE,GTYPE) "RTN","DGPTDD",201,0) .. E S CLEAR=1 "RTN","DGPTDD",202,0) I CLEAR("ALL") D Q "RTN","DGPTDD",203,0) . K ^XTMP(NAME,NODE),^XTMP(NAME,"B",FILE,IEN("TOP")) "RTN","DGPTDD",204,0) . I $O(^XTMP(NAME,0))="" K ^XTMP(NAME) "RTN","DGPTDD",205,0) ; "RTN","DGPTDD",206,0) S ^XTMP(NAME,NODE,TYPE,"IENS")=IEN "RTN","DGPTDD",207,0) S ^XTMP(NAME,NODE,"DFN")=DFN "RTN","DGPTDD",208,0) S ^XTMP(NAME,NODE,"INTEREST DATE")=$P($G(^DGPT(IEN("TOP"),0)),U,2) "RTN","DGPTDD",209,0) S ^XTMP(NAME,NODE,"OCCURRED DATE")=$$NOW^XLFDT "RTN","DGPTDD",210,0) S ^XTMP(NAME,NODE,"FILE")=FILE "RTN","DGPTDD",211,0) S INST=+$P($G(^DGPT(IEN("TOP"),0)),U,3) I INST'=0 D "RTN","DGPTDD",212,0) . D F4^XUAF4(INST,.STATION) Q:$P($G(STATION),U,1)=0 "RTN","DGPTDD",213,0) . S INST=$P(STATION,U,1) "RTN","DGPTDD",214,0) I +$G(INST)>0 S ^XTMP(NAME,NODE,"INSTITUTION")=INST "RTN","DGPTDD",215,0) S ^XTMP(NAME,"B",FILE,IEN("TOP"))=NODE "RTN","DGPTDD",216,0) Q "RTN","DGPTDD",217,0) ; "RTN","DGPTDD",218,0) GETFLD(TYPE,SUB) ;RETURN SUBSCRIPT FIELD NAME "RTN","DGPTDD",219,0) N RETURN,NUMBER "RTN","DGPTDD",220,0) S RETURN="" "RTN","DGPTDD",221,0) I TYPE="DISCHARGE" D "RTN","DGPTDD",222,0) . S NUMBER=SUB-2,RETURN="OPC"_$S(NUMBER<10:"0",1:"")_NUMBER Q "RTN","DGPTDD",223,0) I TYPE="PROCEDURE" D "RTN","DGPTDD",224,0) . S NUMBER=SUB-1,RETURN="OPC"_$S(NUMBER<10:"0",1:"")_NUMBER "RTN","DGPTDD",225,0) I TYPE="SURGERY" D "RTN","DGPTDD",226,0) . S NUMBER=SUB-1,RETURN="OPC"_$S(NUMBER<10:"0",1:"")_NUMBER "RTN","DGPTDD",227,0) Q RETURN "RTN","DGPTFN1") 0^2^B5228879^B4615066 "RTN","DGPTFN1",1,0) DGPTFN1 ;ISP/RFR - REGISTRATION EVENT NOTIFIER;Aug 24, 2020@16:27 "RTN","DGPTFN1",2,0) ;;5.3;Registration;**932,1020,1076**;Aug 13, 1993;Build 4 "RTN","DGPTFN1",3,0) ; "RTN","DGPTFN1",4,0) Q "RTN","DGPTFN1",5,0) EN ;NOTIFY PACKAGES OF EVENT(S) "RTN","DGPTFN1",6,0) I '$D(ZTQUEUED) D "RTN","DGPTFN1",7,0) .W @IOF "RTN","DGPTFN1",8,0) .W !?19,"* * * REGISTRATION EVENT NOTIFIER * * *",! "RTN","DGPTFN1",9,0) N NAME,NODE,DIC,X,EXIT,IEN,FILE,TYPES "RTN","DGPTFN1",10,0) ;TYPES(DATA_NODE_NAME)=PROTOCOL_NAME "RTN","DGPTFN1",11,0) S TYPES("DG PTF ICD NOTIFIER")="DG PTF ICD DIAGNOSIS NOTIFIER" "RTN","DGPTFN1",12,0) S TYPES("DG PTF ICD OP NOTIFIER")="DG PTF ICD PROCEDURE NOTIFIER" "RTN","DGPTFN1",13,0) S TYPES("DG SA FILE ENTRY NOTIFIER")="DG SA FILE ENTRY NOTIFIER" "RTN","DGPTFN1",14,0) S NAME="" F S NAME=$O(TYPES(NAME)) Q:NAME=""!($G(EXIT)) D "RTN","DGPTFN1",15,0) .I '$D(ZTQUEUED) W !,"PROCESSING "_NAME_" MESSAGES:",! "RTN","DGPTFN1",16,0) .I '$D(^XTMP(NAME))!($O(^XTMP(NAME,0))="") D Q "RTN","DGPTFN1",17,0) ..I '$D(ZTQUEUED) W " THERE ARE NO DATA CHANGE MESSAGES TO PROCESS.",! H 3 "RTN","DGPTFN1",18,0) ..I $D(^XTMP(NAME)) K ^XTMP(NAME) "RTN","DGPTFN1",19,0) .L +^XTMP(NAME):DILOCKTM "RTN","DGPTFN1",20,0) .I '$T D Q "RTN","DGPTFN1",21,0) ..I '$D(ZTQUEUED) W !,"ANOTHER PROCESS IS ALREADY PROCESSING DATA CHANGE MESSAGES.",! H 3 "RTN","DGPTFN1",22,0) ..S EXIT=1 "RTN","DGPTFN1",23,0) .K ^TMP(NAME,$J) "RTN","DGPTFN1",24,0) .S NODE=0 F S NODE=$O(^XTMP(NAME,NODE)) Q:NODE="" D "RTN","DGPTFN1",25,0) ..I $E(NODE,1)'?1N W " SKIPPING """_NODE_"""",! Q "RTN","DGPTFN1",26,0) ..I '$D(ZTQUEUED) W " PROCESSING """_NODE_"""..." "RTN","DGPTFN1",27,0) ..I NAME="DG PTF ICD NOTIFIER"!(NAME="DG PTF ICD OP NOTIFIER") D "RTN","DGPTFN1",28,0) ...S FILE=$G(^XTMP(NAME,NODE,"FILE")) "RTN","DGPTFN1",29,0) ...K ^XTMP(NAME,NODE,"FILE") "RTN","DGPTFN1",30,0) ..M ^TMP(NAME,$J)=^XTMP(NAME,NODE) "RTN","DGPTFN1",31,0) ..S DIC=101,X=TYPES(NAME) "RTN","DGPTFN1",32,0) ..D EN^XQOR "RTN","DGPTFN1",33,0) ..I NAME="DG PTF ICD NOTIFIER"!(NAME="DG PTF ICD OP NOTIFIER"),FILE'="" D "RTN","DGPTFN1",34,0) ...S IEN=$G(^XTMP(NAME,NODE,"IENS")),IEN=$P(IEN,",",$L(IEN,",")-1) Q:IEN="" "RTN","DGPTFN1",35,0) ...K ^XTMP(NAME,"B",FILE,IEN) "RTN","DGPTFN1",36,0) ..I NAME="DG SA FILE ENTRY NOTIFIER CACHE" D "RTN","DGPTFN1",37,0) ...S IEN=$G(^XTMP(NAME,NODE,"IEN")) Q:IEN="" "RTN","DGPTFN1",38,0) ...K ^XTMP(NAME,"B",IEN) "RTN","DGPTFN1",39,0) ..K DIC,X,^TMP(NAME,$J),^XTMP(NAME,NODE) "RTN","DGPTFN1",40,0) ..I '$D(ZTQUEUED) W "DONE",! "RTN","DGPTFN1",41,0) .K ^XTMP(NAME) "RTN","DGPTFN1",42,0) .L -^XTMP(NAME) "RTN","DGPTFN1",43,0) .W "FINISHED PROCESSING "_NAME_" MESSAGES.",! "RTN","DGPTFN1",44,0) I '$D(ZTQUEUED) W !,"FINISHED PROCESSING ALL DATA CHANGE MESSAGES.",! H 3 "RTN","DGPTFN1",45,0) Q "VER") 8.0^22.2 "BLD",12167,6) ^950 **END** **END**