SD53FY18 ;ALB/TXH - FY18 STOP CODE UPDATES;04/27/17
;;5.3;Scheduling;**663**;AUG 13, 1993;Build 2
;
; Post-init routine updating stop codes in CLINIC STOP file (#40.7)
; for FY2018 updates.
;
Q
;
EN ; Update stop codes in Clinic Stop file 40.7
;
D BMES^XPDUTL("SD*5.3*663 Post-Install starts...")
D:$P($T(NEW+1),";;",2)'="QUIT" ADD ; add new stop code
D:$P($T(OFF+1),";;",2)'="QUIT" INACT ; inactivate
D:$P($T(CHG+1),";;",2)'="QUIT" CHGNM ; change name
D BMES^XPDUTL("SD*5.3*663 Post-Install is complete."),MES^XPDUTL("")
;
Q
;
ADD ; Add new stop code
; SDREC is in format:
; ;;stop code name^code #^restriction type^restriction date^CDR
;
N SDI,SDREC,SDCODE,SDNM,SDRESTYP,SDFDA,SDADDERR,SDIEN,SDRESDT,SDCDR
D BMES^XPDUTL(">>> Adding stop code to the CLINIC STOP (#40.7) file...")
D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 10/1/2017]")
;
; load all new entries
F SDI=1:1 S SDREC=$P($T(NEW+SDI),";;",2) Q:SDREC="QUIT" D
. S SDCODE=$P(SDREC,U,2) ;code
. S SDNM=$P(SDREC,U) ;name
. S SDRESTYP=$P(SDREC,U,3) ;restriction type
. S SDRESDT=$P(SDREC,U,4) ;restriction date
. S SDCDR=$P(SDREC,U,5) ;CDR #
. ;
. ; check if code already exists
. S SDIEN=$$FIND1^DIC(40.7,"","MX",SDCODE,"","","SDADDERR")
. I $D(SDADDERR) D Q
. . D BMES^XPDUTL(" >> ... Unable to add stop code "_SDCODE_" "_SDNM_" to file.")
. . D MES^XPDUTL(" >> ... "_$G(SDADDERR("DIERR",1,"TEXT",1))_".")
. . D MES^XPDUTL(" >> ... Please contact support for assistance...")
. . K SDADDERR
. ;
. ; if code already exists, update it
. I SDIEN D Q
. . D BMES^XPDUTL(" >> Code "_SDCODE_" already exists, update it.")
. . S SDFDA(40.7,"+1,",.01)=SDNM
. . S SDFDA(40.7,"+1,",1)=SDCODE
. . S SDFDA(40.7,"+1,",4)=SDCDR
. . S SDFDA(40.7,"+1,",5)=SDRESTYP
. . S SDFDA(40.7,"+1,",6)=SDRESDT
. . D FILE^DIE(,"SDFDA","SDADDERR")
. . ; check if error
. . I '$D(SDADDERR) D Q
. . . D BMES^XPDUTL(" >> Stop Code "_SDCODE_" "_SDNM_" updated, code already exists.")
. . I $D(SDADDERR) D
. . . D BMES^XPDUTL(" >> ... Unable to add stop code "_SDCODE_" "_SDNM_" to file.")
. . . D MES^XPDUTL(" >> ... "_$G(SDADDERR("DIERR",1,"TEXT",1))_".")
. . . D MES^XPDUTL(" >> ... Please contact support for assistance.")
. ; if code does not exist, add new entry
. ; set field values of new entry
. S SDFDA(40.7,"+1,",.01)=SDNM
. S SDFDA(40.7,"+1,",1)=SDCODE
. S SDFDA(40.7,"+1,",4)=SDCDR
. S SDFDA(40.7,"+1,",5)=SDRESTYP
. S SDFDA(40.7,"+1,",6)=SDRESDT
. ; add new entry
. D UPDATE^DIE("E","SDFDA","","SDADDERR")
. ; check if error
. I '$D(SDADDERR) D Q
. . D BMES^XPDUTL(" >> Stop Code "_SDCODE_" "_SDNM_" added to file.")
. I $D(SDADDERR) D
. . D BMES^XPDUTL(" >> ... Unable to add stop code "_SDCODE_" "_SDNM_" to file.")
. . D MES^XPDUTL(" >> ... "_$G(SDADDERR("DIERR",1,"TEXT",1))_".")
. . D MES^XPDUTL(" >> ... Please contact support for assistance.")
;
D BMES^XPDUTL(">>> Add new stop codes complete.")
D MES^XPDUTL("")
;
Q
;
INACT ; Inactivate stop code
; SDREC is in format: ;;code #^^inactivation date (in FileMan format)
;
N SDI,SDREC,SDCODE,SDEXDT,SDINDT,SDNM,SDINTERR
D BMES^XPDUTL(">>> Inactivating stop codes in CLINIC STOP (#40.7) file...")
D BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date.]")
;
; load entries w/ inactivate date
F SDI=1:1 S SDREC=$P($T(OFF+SDI),";;",2) Q:SDREC="QUIT" D
. S SDCODE=$P(SDREC,U) ;code
. ; get inactivate date and validate date passed in
. I +$P(SDREC,U,3) D
. . S X=$P(SDREC,U,3)
. . S %DT="FTX"
. . D ^%DT
. . Q:Y<0
. . S SDINDT=Y
. . D DD^%DT
. . S SDEXDT=Y
. . ; check if code already exists
. . S SDIEN=$$FIND1^DIC(40.7,"","MX",SDCODE,"","","SDINTERR")
. . I 'SDIEN D Q
. . . D BMES^XPDUTL(" >> ... Unable to find stop code: "_SDCODE)
. . . D MES^XPDUTL(" >> ... Please contact support for assistance.")
. . ; check if error
. . I $D(SDADDERR) D Q
. . . D BMES^XPDUTL(" >> ... Unable to inactivate stop code "_SDCODE)
. . . D MES^XPDUTL(" >> ... "_$G(SDINTERR("DIERR",1,"TEXT",1))_".")
. . . D MES^XPDUTL(" >> ... Please contact support for assistance...")
. . ; if no error, check if active
. . I $D(^DIC(40.7,SDIEN,0)) I $P(^(0),U,3)="" D
. . . S SDNM=$P($G(^DIC(40.7,SDIEN,0)),U) ;code name
. . . ; set field value
. . . K SDFDA
. . . S SDFDA(40.7,SDIEN_",",2)=SDINDT
. . . D FILE^DIE(,"SDFDA","SDINTERR")
. . . ; check if error
. . . I $D(SDINTERR) D Q
. . . . D BMES^XPDUTL(" >> ... Unable to inactivate stop code: "_SDCODE)
. . . . D MES^XPDUTL(" >> ... "_$G(SDINTERR("DIERR",1,"TEXT",1))_".")
. . . . D MES^XPDUTL(" >> ... Please contact support for assistance.")
. . . I '$D(SDINTERR) D
. . . . D BMES^XPDUTL(" >> Inactivated: "_+SDCODE_" "_SDNM_" as of "_SDEXDT)
;
D BMES^XPDUTL(">>> Inactivation complete.")
K %,%DT,%H,%I,DIC,X,Y
D MES^XPDUTL("")
;
Q
;
CHGNM ; Change code names
; SDREC is in format: ;;code name^code #^^new code name
;
N SDI,SDCODE,SDIEN,SDNEWNM,SDNM,SDREC,SDCHGERR
D BMES^XPDUTL(">>> Changing code names in CLINIC STOP (#40.7) file...")
;
; load entries
F SDI=1:1 S SDREC=$P($T(CHG+SDI),";;",2) Q:SDREC="QUIT" D
. S SDNM=$P(SDREC,U) ;current name
. S SDCODE=$P(SDREC,U,2) ;code
. S SDNEWNM=$P(SDREC,U,4) ;new name
. ; check if code already exists
. S SDIEN=$$FIND1^DIC(40.7,"","MX",SDCODE,"","","SDCHGERR")
. ; check if error
. I $D(SDINTERR) D Q
. . D BMES^XPDUTL(" >> ... Unable to inactivate stop code: "_SDCODE)
. . D MES^XPDUTL(" >> ... "_$G(SDCHGERR("DIERR",1,"TEXT",1))_".")
. . D MES^XPDUTL(" >> ... Please contact support for assistance...")
. ; quit if no entry in file
. I 'SDIEN D Q
. . D BMES^XPDUTL(" >> ... Unable to find stop code: "_SDCODE)
. . D MES^XPDUTL(" >> ... Please contact support for assistance.")
. ; check if code is active
. I $D(^DIC(40.7,SDIEN,0)) I $P(^(0),U,3)="" D
. . K SDFDA
. . S SDFDA(40.7,SDIEN_",",.01)=SDNEWNM
. . D FILE^DIE(,"SDFDA","SDCHGERR")
. . ; check if error
. . I $D(SDCHGERR) D Q
. . . D BMES^XPDUTL(" >> ... Unable to change name for stop code: "_SDCODE)
. . . D MES^XPDUTL(" >> ... "_$G(SDCHGERR("DIERR",1,"TEXT",1))_".")
. . . D MES^XPDUTL(" >> ... Please contact support for assistance.")
. . I '$D(SDCHGERR) D
. . . D BMES^XPDUTL(" >> Stop Code "_SDCODE_" name changed from: "_SDNM)
. . . D MES^XPDUTL(" to: "_SDNEWNM)
;
D BMES^XPDUTL(">>> Changing code names complete.")
;
Q
;
NEW ; codes to add - ;;stop code name^code #^restriction type^restriction date^CDR
;;CARDIOTHORACIC SURG^486^E
;;BARIATRIC SURG^487^E
;;SURG ONCOLOGY^488^E
;;SPINAL SURG^489^E
;;QUIT
;
OFF ; codes to be inactivated - ;;code #^^inactive date
;;295^^10/1/2017
;;412^^10/1/2017
;;416^^10/1/2017
;;422^^10/1/2017
;;426^^10/1/2017
;;431^^10/1/2017
;;433^^10/1/2017
;;571^^10/1/2017
;;572^^10/1/2017
;;QUIT
;
CHG ; Code name changes - ;;code name^code #^^new code name
;;PHARM/PHYSIO NMP STUDIES^145^^MYOCARD PERF STUDIES
;;CARDIAC STRESS TEST/ETT^334^^CARDIAC STRESS TEST
;;ENT^403^^OTOLARYNGOLOGY/ENT
;;ORTHOPEDICS^409^^ORTHO/JOINT SURG
;;PRE-SURG EVAL BY MD^432^^PRE-SURG EVAL
;;SF TH PRV SITE(SAMSTA)^695^^SF TH PRV SITE SAME DIV/STA
;;QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53FY18 7519 printed Apr 09, 2024@21:52:10 Page 2
SD53FY18 ;ALB/TXH - FY18 STOP CODE UPDATES;04/27/17
+1 ;;5.3;Scheduling;**663**;AUG 13, 1993;Build 2
+2 ;
+3 ; Post-init routine updating stop codes in CLINIC STOP file (#40.7)
+4 ; for FY2018 updates.
+5 ;
+6 QUIT
+7 ;
EN ; Update stop codes in Clinic Stop file 40.7
+1 ;
+2 DO BMES^XPDUTL("SD*5.3*663 Post-Install starts...")
+3 ; add new stop code
if $PIECE($TEXT(NEW+1),";;",2)'="QUIT"
DO ADD
+4 ; inactivate
if $PIECE($TEXT(OFF+1),";;",2)'="QUIT"
DO INACT
+5 ; change name
if $PIECE($TEXT(CHG+1),";;",2)'="QUIT"
DO CHGNM
+6 DO BMES^XPDUTL("SD*5.3*663 Post-Install is complete.")
DO MES^XPDUTL("")
+7 ;
+8 QUIT
+9 ;
ADD ; Add new stop code
+1 ; SDREC is in format:
+2 ; ;;stop code name^code #^restriction type^restriction date^CDR
+3 ;
+4 NEW SDI,SDREC,SDCODE,SDNM,SDRESTYP,SDFDA,SDADDERR,SDIEN,SDRESDT,SDCDR
+5 DO BMES^XPDUTL(">>> Adding stop code to the CLINIC STOP (#40.7) file...")
+6 DO BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used UNTIL 10/1/2017]")
+7 ;
+8 ; load all new entries
+9 FOR SDI=1:1
SET SDREC=$PIECE($TEXT(NEW+SDI),";;",2)
if SDREC="QUIT"
QUIT
Begin DoDot:1
+10 ;code
SET SDCODE=$PIECE(SDREC,U,2)
+11 ;name
SET SDNM=$PIECE(SDREC,U)
+12 ;restriction type
SET SDRESTYP=$PIECE(SDREC,U,3)
+13 ;restriction date
SET SDRESDT=$PIECE(SDREC,U,4)
+14 ;CDR #
SET SDCDR=$PIECE(SDREC,U,5)
+15 ;
+16 ; check if code already exists
+17 SET SDIEN=$$FIND1^DIC(40.7,"","MX",SDCODE,"","","SDADDERR")
+18 IF $DATA(SDADDERR)
Begin DoDot:2
+19 DO BMES^XPDUTL(" >> ... Unable to add stop code "_SDCODE_" "_SDNM_" to file.")
+20 DO MES^XPDUTL(" >> ... "_$GET(SDADDERR("DIERR",1,"TEXT",1))_".")
+21 DO MES^XPDUTL(" >> ... Please contact support for assistance...")
+22 KILL SDADDERR
End DoDot:2
QUIT
+23 ;
+24 ; if code already exists, update it
+25 IF SDIEN
Begin DoDot:2
+26 DO BMES^XPDUTL(" >> Code "_SDCODE_" already exists, update it.")
+27 SET SDFDA(40.7,"+1,",.01)=SDNM
+28 SET SDFDA(40.7,"+1,",1)=SDCODE
+29 SET SDFDA(40.7,"+1,",4)=SDCDR
+30 SET SDFDA(40.7,"+1,",5)=SDRESTYP
+31 SET SDFDA(40.7,"+1,",6)=SDRESDT
+32 DO FILE^DIE(,"SDFDA","SDADDERR")
+33 ; check if error
+34 IF '$DATA(SDADDERR)
Begin DoDot:3
+35 DO BMES^XPDUTL(" >> Stop Code "_SDCODE_" "_SDNM_" updated, code already exists.")
End DoDot:3
QUIT
+36 IF $DATA(SDADDERR)
Begin DoDot:3
+37 DO BMES^XPDUTL(" >> ... Unable to add stop code "_SDCODE_" "_SDNM_" to file.")
+38 DO MES^XPDUTL(" >> ... "_$GET(SDADDERR("DIERR",1,"TEXT",1))_".")
+39 DO MES^XPDUTL(" >> ... Please contact support for assistance.")
End DoDot:3
End DoDot:2
QUIT
+40 ; if code does not exist, add new entry
+41 ; set field values of new entry
+42 SET SDFDA(40.7,"+1,",.01)=SDNM
+43 SET SDFDA(40.7,"+1,",1)=SDCODE
+44 SET SDFDA(40.7,"+1,",4)=SDCDR
+45 SET SDFDA(40.7,"+1,",5)=SDRESTYP
+46 SET SDFDA(40.7,"+1,",6)=SDRESDT
+47 ; add new entry
+48 DO UPDATE^DIE("E","SDFDA","","SDADDERR")
+49 ; check if error
+50 IF '$DATA(SDADDERR)
Begin DoDot:2
+51 DO BMES^XPDUTL(" >> Stop Code "_SDCODE_" "_SDNM_" added to file.")
End DoDot:2
QUIT
+52 IF $DATA(SDADDERR)
Begin DoDot:2
+53 DO BMES^XPDUTL(" >> ... Unable to add stop code "_SDCODE_" "_SDNM_" to file.")
+54 DO MES^XPDUTL(" >> ... "_$GET(SDADDERR("DIERR",1,"TEXT",1))_".")
+55 DO MES^XPDUTL(" >> ... Please contact support for assistance.")
End DoDot:2
End DoDot:1
+56 ;
+57 DO BMES^XPDUTL(">>> Add new stop codes complete.")
+58 DO MES^XPDUTL("")
+59 ;
+60 QUIT
+61 ;
INACT ; Inactivate stop code
+1 ; SDREC is in format: ;;code #^^inactivation date (in FileMan format)
+2 ;
+3 NEW SDI,SDREC,SDCODE,SDEXDT,SDINDT,SDNM,SDINTERR
+4 DO BMES^XPDUTL(">>> Inactivating stop codes in CLINIC STOP (#40.7) file...")
+5 DO BMES^XPDUTL(" [NOTE: These Stop Codes CANNOT be used AFTER the indicated inactivation date.]")
+6 ;
+7 ; load entries w/ inactivate date
+8 FOR SDI=1:1
SET SDREC=$PIECE($TEXT(OFF+SDI),";;",2)
if SDREC="QUIT"
QUIT
Begin DoDot:1
+9 ;code
SET SDCODE=$PIECE(SDREC,U)
+10 ; get inactivate date and validate date passed in
+11 IF +$PIECE(SDREC,U,3)
Begin DoDot:2
+12 SET X=$PIECE(SDREC,U,3)
+13 SET %DT="FTX"
+14 DO ^%DT
+15 if Y<0
QUIT
+16 SET SDINDT=Y
+17 DO DD^%DT
+18 SET SDEXDT=Y
+19 ; check if code already exists
+20 SET SDIEN=$$FIND1^DIC(40.7,"","MX",SDCODE,"","","SDINTERR")
+21 IF 'SDIEN
Begin DoDot:3
+22 DO BMES^XPDUTL(" >> ... Unable to find stop code: "_SDCODE)
+23 DO MES^XPDUTL(" >> ... Please contact support for assistance.")
End DoDot:3
QUIT
+24 ; check if error
+25 IF $DATA(SDADDERR)
Begin DoDot:3
+26 DO BMES^XPDUTL(" >> ... Unable to inactivate stop code "_SDCODE)
+27 DO MES^XPDUTL(" >> ... "_$GET(SDINTERR("DIERR",1,"TEXT",1))_".")
+28 DO MES^XPDUTL(" >> ... Please contact support for assistance...")
End DoDot:3
QUIT
+29 ; if no error, check if active
+30 IF $DATA(^DIC(40.7,SDIEN,0))
IF $PIECE(^(0),U,3)=""
Begin DoDot:3
+31 ;code name
SET SDNM=$PIECE($GET(^DIC(40.7,SDIEN,0)),U)
+32 ; set field value
+33 KILL SDFDA
+34 SET SDFDA(40.7,SDIEN_",",2)=SDINDT
+35 DO FILE^DIE(,"SDFDA","SDINTERR")
+36 ; check if error
+37 IF $DATA(SDINTERR)
Begin DoDot:4
+38 DO BMES^XPDUTL(" >> ... Unable to inactivate stop code: "_SDCODE)
+39 DO MES^XPDUTL(" >> ... "_$GET(SDINTERR("DIERR",1,"TEXT",1))_".")
+40 DO MES^XPDUTL(" >> ... Please contact support for assistance.")
End DoDot:4
QUIT
+41 IF '$DATA(SDINTERR)
Begin DoDot:4
+42 DO BMES^XPDUTL(" >> Inactivated: "_+SDCODE_" "_SDNM_" as of "_SDEXDT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 DO BMES^XPDUTL(">>> Inactivation complete.")
+45 KILL %,%DT,%H,%I,DIC,X,Y
+46 DO MES^XPDUTL("")
+47 ;
+48 QUIT
+49 ;
CHGNM ; Change code names
+1 ; SDREC is in format: ;;code name^code #^^new code name
+2 ;
+3 NEW SDI,SDCODE,SDIEN,SDNEWNM,SDNM,SDREC,SDCHGERR
+4 DO BMES^XPDUTL(">>> Changing code names in CLINIC STOP (#40.7) file...")
+5 ;
+6 ; load entries
+7 FOR SDI=1:1
SET SDREC=$PIECE($TEXT(CHG+SDI),";;",2)
if SDREC="QUIT"
QUIT
Begin DoDot:1
+8 ;current name
SET SDNM=$PIECE(SDREC,U)
+9 ;code
SET SDCODE=$PIECE(SDREC,U,2)
+10 ;new name
SET SDNEWNM=$PIECE(SDREC,U,4)
+11 ; check if code already exists
+12 SET SDIEN=$$FIND1^DIC(40.7,"","MX",SDCODE,"","","SDCHGERR")
+13 ; check if error
+14 IF $DATA(SDINTERR)
Begin DoDot:2
+15 DO BMES^XPDUTL(" >> ... Unable to inactivate stop code: "_SDCODE)
+16 DO MES^XPDUTL(" >> ... "_$GET(SDCHGERR("DIERR",1,"TEXT",1))_".")
+17 DO MES^XPDUTL(" >> ... Please contact support for assistance...")
End DoDot:2
QUIT
+18 ; quit if no entry in file
+19 IF 'SDIEN
Begin DoDot:2
+20 DO BMES^XPDUTL(" >> ... Unable to find stop code: "_SDCODE)
+21 DO MES^XPDUTL(" >> ... Please contact support for assistance.")
End DoDot:2
QUIT
+22 ; check if code is active
+23 IF $DATA(^DIC(40.7,SDIEN,0))
IF $PIECE(^(0),U,3)=""
Begin DoDot:2
+24 KILL SDFDA
+25 SET SDFDA(40.7,SDIEN_",",.01)=SDNEWNM
+26 DO FILE^DIE(,"SDFDA","SDCHGERR")
+27 ; check if error
+28 IF $DATA(SDCHGERR)
Begin DoDot:3
+29 DO BMES^XPDUTL(" >> ... Unable to change name for stop code: "_SDCODE)
+30 DO MES^XPDUTL(" >> ... "_$GET(SDCHGERR("DIERR",1,"TEXT",1))_".")
+31 DO MES^XPDUTL(" >> ... Please contact support for assistance.")
End DoDot:3
QUIT
+32 IF '$DATA(SDCHGERR)
Begin DoDot:3
+33 DO BMES^XPDUTL(" >> Stop Code "_SDCODE_" name changed from: "_SDNM)
+34 DO MES^XPDUTL(" to: "_SDNEWNM)
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 DO BMES^XPDUTL(">>> Changing code names complete.")
+37 ;
+38 QUIT
+39 ;
NEW ; codes to add - ;;stop code name^code #^restriction type^restriction date^CDR
+1 ;;CARDIOTHORACIC SURG^486^E
+2 ;;BARIATRIC SURG^487^E
+3 ;;SURG ONCOLOGY^488^E
+4 ;;SPINAL SURG^489^E
+5 ;;QUIT
+6 ;
OFF ; codes to be inactivated - ;;code #^^inactive date
+1 ;;295^^10/1/2017
+2 ;;412^^10/1/2017
+3 ;;416^^10/1/2017
+4 ;;422^^10/1/2017
+5 ;;426^^10/1/2017
+6 ;;431^^10/1/2017
+7 ;;433^^10/1/2017
+8 ;;571^^10/1/2017
+9 ;;572^^10/1/2017
+10 ;;QUIT
+11 ;
CHG ; Code name changes - ;;code name^code #^^new code name
+1 ;;PHARM/PHYSIO NMP STUDIES^145^^MYOCARD PERF STUDIES
+2 ;;CARDIAC STRESS TEST/ETT^334^^CARDIAC STRESS TEST
+3 ;;ENT^403^^OTOLARYNGOLOGY/ENT
+4 ;;ORTHOPEDICS^409^^ORTHO/JOINT SURG
+5 ;;PRE-SURG EVAL BY MD^432^^PRE-SURG EVAL
+6 ;;SF TH PRV SITE(SAMSTA)^695^^SF TH PRV SITE SAME DIV/STA
+7 ;;QUIT
+8 ;
