SD53P876 ;BAH/DF - SD*5.3*876 Post Init Routine ;Jan 11, 2024
;;5.3;Scheduling;**876**;Aug 13, 1993;Build 5
;
; load new Stop codes to the SD TELE HEALTH STOP CODE FILE #40.6.
; *** post install can be rerun with no harm ***
;
Q
EN ; entry point
N ERRCNT,FDA,SDIEN,ERR,STP,DA,DIK
S ERRCNT=0
D MES^XPDUTL("")
D MES^XPDUTL("Updating of SD TELE HEALTH STOP CODE FILE...")
;Add new codes
D MES^XPDUTL("") H 1
F STP=355 D
. I $O(^SD(40.6,"B",STP,"")) D MES^XPDUTL(STP_" already on file") Q
. I '$$CHKSTOP^SDTMPEDT(STP) D MES^XPDUTL(STP_" ** Not added, invalid stop code") Q
. S FDA(40.6,"+1,",.01)=STP D UPDATE^DIE("","FDA","SDIEN","ERR")
. D:'$D(ERR) MES^XPDUTL(STP_" added stop code")
. I $D(ERR) D MES^XPDUTL(STP_" failed an attempt to add to the file.") S ERRCNT=ERRCNT+1
. K FDA,SDIEN,ERR
;Delete removed codes
S DIK="^SD(40.6,"
F STP=656 D
. S DA=$O(^SD(40.6,"B",STP,""))
. I 'DA D MES^XPDUTL(STP_" already deleted") Q
. D ^DIK
. D MES^XPDUTL(STP_" deleted")
D MES^XPDUTL("")
D MES^XPDUTL("Stop Code Update completed. "_ERRCNT_" error(s) found.")
D MES^XPDUTL("") H 2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P876 1154 printed Dec 13, 2024@02:46:47 Page 2
SD53P876 ;BAH/DF - SD*5.3*876 Post Init Routine ;Jan 11, 2024
+1 ;;5.3;Scheduling;**876**;Aug 13, 1993;Build 5
+2 ;
+3 ; load new Stop codes to the SD TELE HEALTH STOP CODE FILE #40.6.
+4 ; *** post install can be rerun with no harm ***
+5 ;
+6 QUIT
EN ; entry point
+1 NEW ERRCNT,FDA,SDIEN,ERR,STP,DA,DIK
+2 SET ERRCNT=0
+3 DO MES^XPDUTL("")
+4 DO MES^XPDUTL("Updating of SD TELE HEALTH STOP CODE FILE...")
+5 ;Add new codes
+6 DO MES^XPDUTL("")
HANG 1
+7 FOR STP=355
Begin DoDot:1
+8 IF $ORDER(^SD(40.6,"B",STP,""))
DO MES^XPDUTL(STP_" already on file")
QUIT
+9 IF '$$CHKSTOP^SDTMPEDT(STP)
DO MES^XPDUTL(STP_" ** Not added, invalid stop code")
QUIT
+10 SET FDA(40.6,"+1,",.01)=STP
DO UPDATE^DIE("","FDA","SDIEN","ERR")
+11 if '$DATA(ERR)
DO MES^XPDUTL(STP_" added stop code")
+12 IF $DATA(ERR)
DO MES^XPDUTL(STP_" failed an attempt to add to the file.")
SET ERRCNT=ERRCNT+1
+13 KILL FDA,SDIEN,ERR
End DoDot:1
+14 ;Delete removed codes
+15 SET DIK="^SD(40.6,"
+16 FOR STP=656
Begin DoDot:1
+17 SET DA=$ORDER(^SD(40.6,"B",STP,""))
+18 IF 'DA
DO MES^XPDUTL(STP_" already deleted")
QUIT
+19 DO ^DIK
+20 DO MES^XPDUTL(STP_" deleted")
End DoDot:1
+21 DO MES^XPDUTL("")
+22 DO MES^XPDUTL("Stop Code Update completed. "_ERRCNT_" error(s) found.")
+23 DO MES^XPDUTL("")
HANG 2
+24 QUIT
