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 ---[H[J[2J[HDVBAP232 2507 printed Apr 09, 2024@20:44:39 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 ;
