EC2P126 ;ALB/DAN Post-install events for Event Capture patch 126 ;11/18/14 15:38
;;2.0;EVENT CAPTURE;**126**;8 May 96;Build 8
;
POST ;Come here for post-install actions
D REASON ;Update procedure reason file
Q
;
REASON ;Modify entries in file 720.4
;
N ECXFDA,ECXERR,ECREAS,I,DONE,IEN,FDA
;
;-add procedure reason
F I=1:1 S ECREAS=$P($T(ADDREAS+I),";;",2) Q:ECREAS="QUIT" D
.;
.;-quit w/error message if entry already exists in file #720.4
.I $$FIND1^DIC(720.4,"","X",ECREAS) D Q
..D BMES^XPDUTL(">>>..."_ECREAS_" not added, entry already exists.")
.;
.;Setup field values of new entry
.S ECXFDA(720.4,"+1,",.01)=ECREAS
.S ECXFDA(720.4,"+1,",.02)=1 ;Set "ACTIVE?" field to 1 (active)
.;
.;-add new entry to file #720.4
.D UPDATE^DIE("E","ECXFDA","","ECXERR")
.;
.I '$D(ECXERR) D BMES^XPDUTL(">>>..."_ECREAS_" added to file.")
.I $D(ECXERR) D BMES^XPDUTL(">>>...Unable to add "_ECREAS_" to file.")
;
;update procedure reason
F I=1:1 S ECREAS=$P($T(CHGREAS+I),";;",2) Q:ECREAS="QUIT" D
.S IEN=$$FIND1^DIC(720.4,"","X",$P(ECREAS,";"))
.I '+IEN D Q
..I $$FIND1^DIC(720.4,"","X",$P(ECREAS,";",2)) D BMES^XPDUTL(">>>..."_$P(ECREAS,";")_" already updated.") Q
..D BMES^XPDUTL(">>>...unable to change "_$P(ECREAS,";")_" - Entry not found!")
.S FDA(720.4,IEN_",",".01")=$P(ECREAS,";",2)
.D FILE^DIE("","FDA")
.D BMES^XPDUTL(">>>..."_$P(ECREAS,";")_" updated to "_$P(ECREAS,";",2))
Q
;
ADDREAS ;List of new procedure reasons
;;CHAP MIL SEXUAL TRAUMA
;;CHAP DOM/TREATMENT CENTERS
;;QUIT
;
CHGREAS ;List of procedure reasons to be updated
;;CHAP PRRP;CHAP PRRP/PRTP INP/OUT
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P126 1663 printed Dec 13, 2024@01:54:49 Page 2
EC2P126 ;ALB/DAN Post-install events for Event Capture patch 126 ;11/18/14 15:38
+1 ;;2.0;EVENT CAPTURE;**126**;8 May 96;Build 8
+2 ;
POST ;Come here for post-install actions
+1 ;Update procedure reason file
DO REASON
+2 QUIT
+3 ;
REASON ;Modify entries in file 720.4
+1 ;
+2 NEW ECXFDA,ECXERR,ECREAS,I,DONE,IEN,FDA
+3 ;
+4 ;-add procedure reason
+5 FOR I=1:1
SET ECREAS=$PIECE($TEXT(ADDREAS+I),";;",2)
if ECREAS="QUIT"
QUIT
Begin DoDot:1
+6 ;
+7 ;-quit w/error message if entry already exists in file #720.4
+8 IF $$FIND1^DIC(720.4,"","X",ECREAS)
Begin DoDot:2
+9 DO BMES^XPDUTL(">>>..."_ECREAS_" not added, entry already exists.")
End DoDot:2
QUIT
+10 ;
+11 ;Setup field values of new entry
+12 SET ECXFDA(720.4,"+1,",.01)=ECREAS
+13 ;Set "ACTIVE?" field to 1 (active)
SET ECXFDA(720.4,"+1,",.02)=1
+14 ;
+15 ;-add new entry to file #720.4
+16 DO UPDATE^DIE("E","ECXFDA","","ECXERR")
+17 ;
+18 IF '$DATA(ECXERR)
DO BMES^XPDUTL(">>>..."_ECREAS_" added to file.")
+19 IF $DATA(ECXERR)
DO BMES^XPDUTL(">>>...Unable to add "_ECREAS_" to file.")
End DoDot:1
+20 ;
+21 ;update procedure reason
+22 FOR I=1:1
SET ECREAS=$PIECE($TEXT(CHGREAS+I),";;",2)
if ECREAS="QUIT"
QUIT
Begin DoDot:1
+23 SET IEN=$$FIND1^DIC(720.4,"","X",$PIECE(ECREAS,";"))
+24 IF '+IEN
Begin DoDot:2
+25 IF $$FIND1^DIC(720.4,"","X",$PIECE(ECREAS,";",2))
DO BMES^XPDUTL(">>>..."_$PIECE(ECREAS,";")_" already updated.")
QUIT
+26 DO BMES^XPDUTL(">>>...unable to change "_$PIECE(ECREAS,";")_" - Entry not found!")
End DoDot:2
QUIT
+27 SET FDA(720.4,IEN_",",".01")=$PIECE(ECREAS,";",2)
+28 DO FILE^DIE("","FDA")
+29 DO BMES^XPDUTL(">>>..."_$PIECE(ECREAS,";")_" updated to "_$PIECE(ECREAS,";",2))
End DoDot:1
+30 QUIT
+31 ;
ADDREAS ;List of new procedure reasons
+1 ;;CHAP MIL SEXUAL TRAUMA
+2 ;;CHAP DOM/TREATMENT CENTERS
+3 ;;QUIT
+4 ;
CHGREAS ;List of procedure reasons to be updated
+1 ;;CHAP PRRP;CHAP PRRP/PRTP INP/OUT
+2 ;;QUIT
