DVBAP232.m

DVBAP232 ;ALB/TH - 2507 SPECIAL CONSIDERATIONS FILE UPDATE ; Mar 24, 2021@09:22:10

 ;;2.7;AMIE;**232**;Apr 10, 1995;Build 1

 ;

 ; This routine is used as a post-install in a KIDS build to modify 

 ; the 2507 SPECIAL CONSIDERATIONS file (#396.25).

 ;

 ; Reference to $$FIND1^DIC supported by ICR# 2051

 ; Reference to UPDATE^DIE supported by ICR# 2053

 ; Reference to BMES^XPDUTL supported by ICR# 10141

 ; Reference to MES^XPDUTL supported by ICR# 10141

 ;

 Q

 ;

POST ; Update Special Considerations in 2507 SPECIAL CONSIDERATIONS file (#396.25)

 ;

 D BMES^XPDUTL("DVBA*2.7*232 Post-Install starts...")

 D:$P($T(NEW+1),";;",2)'="QUIT" ADD      ; add new special consideration reason

 D MES^XPDUTL("DVBA*2.7*232 Post-Install is complete."),MES^XPDUTL("")

 K DVBAIEN,%H,%I,DIC,X,Y

 Q

 ;

ADD ; Add new Special Considerations

 ; DVBAREC is in format: 

 ;   ;;Special Consideration name

 ;

 D BMES^XPDUTL(">>> Adding Special Consideration to the 2507 SPECIAL CONSIDERATIONS file...")

 ;

 N DVBAI,DVBANM,DVBAREC,DVBFDA

 ; load all new entries

 F DVBAI=1:1 S DVBAREC=$P($T(NEW+DVBAI),";;",2) Q:DVBAREC="QUIT"  D

 . S DVBANM=$P(DVBAREC,U)       ;name

 . ;

 . ; check if code already exists in file 396.25

 . S DVBAIEN=$$FIND1^DIC(396.25,"","MX",DVBANM,"","","DVBAERR")

 . I DVBAIEN D  Q

 . . D BMES^XPDUTL("    >> New Special Consideration "_DVBANM_" already exists.")

 . ; quit if error

 . I $D(DVBAERR) D  Q

 . . D BMES^XPDUTL("       >> ... Unable to add Special Consideration "_DVBANM_" to file.")

 . . D MES^XPDUTL("        >> ... "_$G(DVBAERR("DIERR",1,"TEXT",1))_".")

 . . D MES^XPDUTL("        >> ... Please contact support for assistance...")

 . . K DVBAERR

 . ;

 . ; if new reason does not exist, add new entry

 . ; set field values of new entry

 . S DVBFDA(396.25,"+1,",.01)=DVBANM

 . ; add new entry

 . D UPDATE^DIE("E","DVBFDA","","DVBAERR")

 . ; check if error

 . I '$D(DVBAERR) D

 . . D BMES^XPDUTL("    >> Special Consideration "_DVBANM_" added to file.")

 . I $D(DVBAERR) D

 . . D BMES^XPDUTL("    >> ... Unable to add Special Consideration "_DVBANM_" to file.")

 . . D MES^XPDUTL("    >> ... "_$G(DVBAERR("DIERR",1,"TEXT",1))_".")

 . . D MES^XPDUTL("    >> ... Please contact support for assistance.")

 . . ; clean out error array b4 processing next code

 . . K DVBAERR

 ;

 D BMES^XPDUTL(">>> Add new Special Consideration complete.")

 D MES^XPDUTL("")

 Q

 ;

NEW ; codes to add - ;;Special Consideration name^

 ;;VICAP^

 ;;QUIT

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBAP232   2507     printed  Apr 23, 2025@17:55:57                                                                                                                                                                                                    Page 2

DVBAP232  ;ALB/TH - 2507 SPECIAL CONSIDERATIONS FILE UPDATE ; Mar 24, 2021@09:22:10

 +1       ;;2.7;AMIE;**232**;Apr 10, 1995;Build 1

 +2       ;

 +3       ; This routine is used as a post-install in a KIDS build to modify 

 +4       ; the 2507 SPECIAL CONSIDERATIONS file (#396.25).

 +5       ;

 +6       ; Reference to $$FIND1^DIC supported by ICR# 2051

 +7       ; Reference to UPDATE^DIE supported by ICR# 2053

 +8       ; Reference to BMES^XPDUTL supported by ICR# 10141

 +9       ; Reference to MES^XPDUTL supported by ICR# 10141

 +10      ;

 +11       QUIT 

 +12      ;

POST      ; Update Special Considerations in 2507 SPECIAL CONSIDERATIONS file (#396.25)

 +1       ;

 +2        DO BMES^XPDUTL("DVBA*2.7*232 Post-Install starts...")

 +3       ; add new special consideration reason

           if $PIECE($TEXT(NEW+1),";;",2)'="QUIT"

               DO ADD

 +4        DO MES^XPDUTL("DVBA*2.7*232 Post-Install is complete.")

           DO MES^XPDUTL("")

 +5        KILL DVBAIEN,%H,%I,DIC,X,Y

 +6        QUIT 

 +7       ;

ADD       ; Add new Special Considerations

 +1       ; DVBAREC is in format: 

 +2       ;   ;;Special Consideration name

 +3       ;

 +4        DO BMES^XPDUTL(">>> Adding Special Consideration to the 2507 SPECIAL CONSIDERATIONS file...")

 +5       ;

 +6        NEW DVBAI,DVBANM,DVBAREC,DVBFDA

 +7       ; load all new entries

 +8        FOR DVBAI=1:1

               SET DVBAREC=$PIECE($TEXT(NEW+DVBAI),";;",2)

               if DVBAREC="QUIT"

                   QUIT 

               Begin DoDot:1

 +9       ;name

                   SET DVBANM=$PIECE(DVBAREC,U)

 +10      ;

 +11      ; check if code already exists in file 396.25

 +12               SET DVBAIEN=$$FIND1^DIC(396.25,"","MX",DVBANM,"","","DVBAERR")

 +13               IF DVBAIEN

                       Begin DoDot:2

 +14                       DO BMES^XPDUTL("    >> New Special Consideration "_DVBANM_" already exists.")

                       End DoDot:2

                       QUIT 

 +15      ; quit if error

 +16               IF $DATA(DVBAERR)

                       Begin DoDot:2

 +17                       DO BMES^XPDUTL("       >> ... Unable to add Special Consideration "_DVBANM_" to file.")

 +18                       DO MES^XPDUTL("        >> ... "_$GET(DVBAERR("DIERR",1,"TEXT",1))_".")

 +19                       DO MES^XPDUTL("        >> ... Please contact support for assistance...")

 +20                       KILL DVBAERR

                       End DoDot:2

                       QUIT 

 +21      ;

 +22      ; if new reason does not exist, add new entry

 +23      ; set field values of new entry

 +24               SET DVBFDA(396.25,"+1,",.01)=DVBANM

 +25      ; add new entry

 +26               DO UPDATE^DIE("E","DVBFDA","","DVBAERR")

 +27      ; check if error

 +28               IF '$DATA(DVBAERR)

                       Begin DoDot:2

 +29                       DO BMES^XPDUTL("    >> Special Consideration "_DVBANM_" added to file.")

                       End DoDot:2

 +30               IF $DATA(DVBAERR)

                       Begin DoDot:2

 +31                       DO BMES^XPDUTL("    >> ... Unable to add Special Consideration "_DVBANM_" to file.")

 +32                       DO MES^XPDUTL("    >> ... "_$GET(DVBAERR("DIERR",1,"TEXT",1))_".")

 +33                       DO MES^XPDUTL("    >> ... Please contact support for assistance.")

 +34      ; clean out error array b4 processing next code

 +35                       KILL DVBAERR

                       End DoDot:2

               End DoDot:1

 +36      ;

 +37       DO BMES^XPDUTL(">>> Add new Special Consideration complete.")

 +38       DO MES^XPDUTL("")

 +39       QUIT 

 +40      ;

NEW       ; codes to add - ;;Special Consideration name^

 +1       ;;VICAP^

 +2       ;;QUIT

 +3       ;