ECX3P157.m

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 ---ECX3P157   1491     printed  Apr 09, 2024@20:57:18                                                                                                                                                                                                    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