EC2P126.m

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 ---EC2P126   1663     printed  Apr 09, 2024@21:02:45                                                                                                                                                                                                     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