DG531076P ;ISP/RFR - PATCH 1076 POST-INIT;May 21, 2018@16:23
;;5.3;Registration;**1076**;Aug 13, 1993;Build 4
;
POST ; -- post init to build xrefs
D BMES^XPDUTL(" Creating new-style indexes in the PTF (#45) file...")
D TOP
D 601
D 401
Q
;
TOP ; -- AICP index on 401P node fields
N DGPTXR,DGPTRES,DGPTOUT,X
S DGPTXR("FILE")=45
S DGPTXR("NAME")="AICP"
S DGPTXR("TYPE")="MU"
S DGPTXR("USE")="A"
S DGPTXR("EXECUTION")="R"
S DGPTXR("SHORT DESCR")="Notify packages of ICD procedure code change."
S DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol"
S DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added,"
S DGPTXR("DESCR",3)="edited, or removed."
S DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""DISCHARGE"",""SET"")"
S DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""DISCHARGE"",""KILL"")"
S DGPTXR("WHOLE KILL")="Q"
S DGPTXR("VAL",1)=.01 ;Patient
S DGPTXR("VAL",2)=11 ;Type of Record
S DGPTXR("VAL",3)=45.01 ;Procedure n
S DGPTXR("VAL",4)=45.02
S DGPTXR("VAL",5)=45.03
S DGPTXR("VAL",6)=45.04
S DGPTXR("VAL",7)=45.05
D CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT")
S X=" AICP: "_$S(+$G(DGPTRES):"DONE",1:"FAILED")
D MES^XPDUTL(X)
Q
;
601 ; -- AICPP index on 601 multiple
N DGPTXR,DGPTRES,DGPTOUT,I
S DGPTXR("FILE")=45.05
S DGPTXR("NAME")="AICPP"
S DGPTXR("TYPE")="MU"
S DGPTXR("USE")="A"
S DGPTXR("EXECUTION")="R",DGPTXR("ACTIVITY")=""
S DGPTXR("SHORT DESCR")="Notify packages of ICD procedure code change."
S DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol"
S DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added,"
S DGPTXR("DESCR",3)="edited, or removed."
S DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""PROCEDURE"",""SET"")"
S DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""PROCEDURE"",""KILL"")"
S DGPTXR("WHOLE KILL")="Q"
S DGPTXR("VAL",1)=.01
; Procedure Codes 1-25
F I=2:1:26 S DGPTXR("VAL",I)=I+2
D CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT")
S X=" AICPP: "_$S(+$G(DGPTRES):"DONE",1:"FAILED")
D MES^XPDUTL(X)
Q
;
401 ; -- AICPS index on 401 multiple
N DGPTXR,DGPTRES,DGPTOUT,I
S DGPTXR("FILE")=45.01
S DGPTXR("NAME")="AICPS"
S DGPTXR("TYPE")="MU"
S DGPTXR("USE")="A"
S DGPTXR("EXECUTION")="R",DGPTXR("ACTIVITY")=""
S DGPTXR("SHORT DESCR")="Notify packages of ICD diagnosis code change."
S DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol"
S DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added,"
S DGPTXR("DESCR",3)="edited, or removed."
S DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""SURGERY"",""SET"")"
S DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""SURGERY"",""KILL"")"
S DGPTXR("WHOLE KILL")="Q"
S DGPTXR("VAL",1)=.01
; Operation Codes 1-25
F I=2:1:26 S DGPTXR("VAL",I)=I+6
D CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT")
S X=" AICPS: "_$S(+$G(DGPTRES):"DONE",1:"FAILED")
D MES^XPDUTL(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531076P 3098 printed Nov 22, 2024@17:45:49 Page 2
DG531076P ;ISP/RFR - PATCH 1076 POST-INIT;May 21, 2018@16:23
+1 ;;5.3;Registration;**1076**;Aug 13, 1993;Build 4
+2 ;
POST ; -- post init to build xrefs
+1 DO BMES^XPDUTL(" Creating new-style indexes in the PTF (#45) file...")
+2 DO TOP
+3 DO 601
+4 DO 401
+5 QUIT
+6 ;
TOP ; -- AICP index on 401P node fields
+1 NEW DGPTXR,DGPTRES,DGPTOUT,X
+2 SET DGPTXR("FILE")=45
+3 SET DGPTXR("NAME")="AICP"
+4 SET DGPTXR("TYPE")="MU"
+5 SET DGPTXR("USE")="A"
+6 SET DGPTXR("EXECUTION")="R"
+7 SET DGPTXR("SHORT DESCR")="Notify packages of ICD procedure code change."
+8 SET DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol"
+9 SET DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added,"
+10 SET DGPTXR("DESCR",3)="edited, or removed."
+11 SET DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""DISCHARGE"",""SET"")"
+12 SET DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""DISCHARGE"",""KILL"")"
+13 SET DGPTXR("WHOLE KILL")="Q"
+14 ;Patient
SET DGPTXR("VAL",1)=.01
+15 ;Type of Record
SET DGPTXR("VAL",2)=11
+16 ;Procedure n
SET DGPTXR("VAL",3)=45.01
+17 SET DGPTXR("VAL",4)=45.02
+18 SET DGPTXR("VAL",5)=45.03
+19 SET DGPTXR("VAL",6)=45.04
+20 SET DGPTXR("VAL",7)=45.05
+21 DO CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT")
+22 SET X=" AICP: "_$SELECT(+$GET(DGPTRES):"DONE",1:"FAILED")
+23 DO MES^XPDUTL(X)
+24 QUIT
+25 ;
601 ; -- AICPP index on 601 multiple
+1 NEW DGPTXR,DGPTRES,DGPTOUT,I
+2 SET DGPTXR("FILE")=45.05
+3 SET DGPTXR("NAME")="AICPP"
+4 SET DGPTXR("TYPE")="MU"
+5 SET DGPTXR("USE")="A"
+6 SET DGPTXR("EXECUTION")="R"
SET DGPTXR("ACTIVITY")=""
+7 SET DGPTXR("SHORT DESCR")="Notify packages of ICD procedure code change."
+8 SET DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol"
+9 SET DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added,"
+10 SET DGPTXR("DESCR",3)="edited, or removed."
+11 SET DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""PROCEDURE"",""SET"")"
+12 SET DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""PROCEDURE"",""KILL"")"
+13 SET DGPTXR("WHOLE KILL")="Q"
+14 SET DGPTXR("VAL",1)=.01
+15 ; Procedure Codes 1-25
+16 FOR I=2:1:26
SET DGPTXR("VAL",I)=I+2
+17 DO CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT")
+18 SET X=" AICPP: "_$SELECT(+$GET(DGPTRES):"DONE",1:"FAILED")
+19 DO MES^XPDUTL(X)
+20 QUIT
+21 ;
401 ; -- AICPS index on 401 multiple
+1 NEW DGPTXR,DGPTRES,DGPTOUT,I
+2 SET DGPTXR("FILE")=45.01
+3 SET DGPTXR("NAME")="AICPS"
+4 SET DGPTXR("TYPE")="MU"
+5 SET DGPTXR("USE")="A"
+6 SET DGPTXR("EXECUTION")="R"
SET DGPTXR("ACTIVITY")=""
+7 SET DGPTXR("SHORT DESCR")="Notify packages of ICD diagnosis code change."
+8 SET DGPTXR("DESCR",1)="This cross-reference will notify subscribing packages via protocol"
+9 SET DGPTXR("DESCR",2)="DG PTF ICD PROCEDURE NOTIFIER when an ICD procedure code is added,"
+10 SET DGPTXR("DESCR",3)="edited, or removed."
+11 SET DGPTXR("SET")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""SURGERY"",""SET"")"
+12 SET DGPTXR("KILL")="D NOTIFYP^DGPTDD(.X1,.X2,.DA,45,""SURGERY"",""KILL"")"
+13 SET DGPTXR("WHOLE KILL")="Q"
+14 SET DGPTXR("VAL",1)=.01
+15 ; Operation Codes 1-25
+16 FOR I=2:1:26
SET DGPTXR("VAL",I)=I+6
+17 DO CREIXN^DDMOD(.DGPTXR,"kW",.DGPTRES,"DGPTOUT")
+18 SET X=" AICPS: "_$SELECT(+$GET(DGPTRES):"DONE",1:"FAILED")
+19 DO MES^XPDUTL(X)
+20 QUIT
