ECX3P157 ;ALB/DE - ECX*3.0*152 Post-Init RTN;04/06/15
;;3.0;DSS EXTRACTS;**157**;Dec 22, 1997;Build 1
;
;Post-init routine updating current entries in
;the NATIONAL CLINIC (#728.441) file
;
Q
;
EN ;routine entry point
D UPDATE ;change name of existing Clinic codes
Q
;
UPDATE ;changing short description of existing clinic
N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC
D BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file..")
F ECXI=1:1 S ECXREC=$P($T(UPDCLIN+ECXI),";;",2) Q:ECXREC="QUIT" D
.S ECXCODE=$P(ECXREC,"^"),ECXDESC=$P(ECXREC,"^",2)
.S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
.I 'ECXIEN D Q
..D BMES^XPDUTL(">>>...Unable to update "_ECXCODE_" - "_$P(ECXREC,U,2)_".")
..D BMES^XPDUTL(">>>...Contact support for assistance")
.N FDA
.S FDA(728.441,ECXIEN_",",1)=ECXDESC
.D FILE^DIE(,"FDA","ECXERR")
.D BMES^XPDUTL(">>>..."_ECXCODE_" - "_$P(ECXREC,U,2)_" updated")
I '$D(ECXERR) D BMES^XPDUTL("Update complete") Q ;quit here if update was successful
D BMES^XPDUTL("***Errors occurred during install. Please check ECXERR(""DIERR"") for errors***")
Q ;quit here if errors occurred during update
;
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
;;HTTC^Home Sleep Study Pat Educ
;;MICM^MHICM Program
;;NDTR^CBT for Non-epileptic Seizures
;;RNNX^Range Program
;;RNNY^E-Range Program
;;SCTC^CWT Supported Education
;;SCUC^CWT Self-Employment
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P157 1491 printed Nov 22, 2024@17:00:28 Page 2
ECX3P157 ;ALB/DE - ECX*3.0*152 Post-Init RTN;04/06/15
+1 ;;3.0;DSS EXTRACTS;**157**;Dec 22, 1997;Build 1
+2 ;
+3 ;Post-init routine updating current entries in
+4 ;the NATIONAL CLINIC (#728.441) file
+5 ;
+6 QUIT
+7 ;
EN ;routine entry point
+1 ;change name of existing Clinic codes
DO UPDATE
+2 QUIT
+3 ;
UPDATE ;changing short description of existing clinic
+1 NEW ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC
+2 DO BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file..")
+3 FOR ECXI=1:1
SET ECXREC=$PIECE($TEXT(UPDCLIN+ECXI),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+4 SET ECXCODE=$PIECE(ECXREC,"^")
SET ECXDESC=$PIECE(ECXREC,"^",2)
+5 SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
+6 IF 'ECXIEN
Begin DoDot:2
+7 DO BMES^XPDUTL(">>>...Unable to update "_ECXCODE_" - "_$PIECE(ECXREC,U,2)_".")
+8 DO BMES^XPDUTL(">>>...Contact support for assistance")
End DoDot:2
QUIT
+9 NEW FDA
+10 SET FDA(728.441,ECXIEN_",",1)=ECXDESC
+11 DO FILE^DIE(,"FDA","ECXERR")
+12 DO BMES^XPDUTL(">>>..."_ECXCODE_" - "_$PIECE(ECXREC,U,2)_" updated")
End DoDot:1
+13 ;quit here if update was successful
IF '$DATA(ECXERR)
DO BMES^XPDUTL("Update complete")
QUIT
+14 DO BMES^XPDUTL("***Errors occurred during install. Please check ECXERR(""DIERR"") for errors***")
+15 ;quit here if errors occurred during update
QUIT
+16 ;
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
+1 ;;HTTC^Home Sleep Study Pat Educ
+2 ;;MICM^MHICM Program
+3 ;;NDTR^CBT for Non-epileptic Seizures
+4 ;;RNNX^Range Program
+5 ;;RNNY^E-Range Program
+6 ;;SCTC^CWT Supported Education
+7 ;;SCUC^CWT Self-Employment
+8 ;;QUIT
