ECX3P167.m

ECX3P167 ;ALB/DE - NATIONAL CLINIC (#728.441) File Update;04/20/17

 ;;3.0;DSS EXTRACTS;**167**;Dec 22, 1997;Build 2

 ;

 ;Post-init routine updating entries in

 ;the NATIONAL CLINIC (#728.441) file

 ;

 Q

 ;

EN ;routine entry point

 D UPDATE ;change short description of existing clinic codes

 D BMES^XPDUTL("Update complete")

 ;

 Q

 ;

UPDATE ;changing short description of existing entries

 ;ECXREC is in format: code^short description

 ;

 N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC,ECXERR

 ;

 D BMES^XPDUTL(">>>Updating entries 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,"","","ECXERR")

  .I 'ECXIEN D  Q

  ..D BMES^XPDUTL(">>>....Unable to find code: "_ECXCODE_".")

  ..D BMES^XPDUTL("*** Please contact support for assistance. ***")

  .K FDA

  .S FDA(728.441,ECXIEN_",",1)=ECXDESC

  .D FILE^DIE(,"FDA","ECXERR")

  .I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" - "_$P(ECXREC,U,2)_" updated")

  .I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to update code "_ECXCODE_".") D

 ..D BMES^XPDUTL("*** Please contact support for assistance. ***")

 ;

 Q

 ;

UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated

 ;;HDHC^HIH Step Down

 ;;SCQC^TELESTROKE

 ;;WCGC^Adv Care Pln Grp

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECX3P167   1409     printed  Apr 09, 2024@20:58:14                                                                                                                                                                                                    Page 2

ECX3P167  ;ALB/DE - NATIONAL CLINIC (#728.441) File Update;04/20/17

 +1       ;;3.0;DSS EXTRACTS;**167**;Dec 22, 1997;Build 2

 +2       ;

 +3       ;Post-init routine updating entries in

 +4       ;the NATIONAL CLINIC (#728.441) file

 +5       ;

 +6        QUIT 

 +7       ;

EN        ;routine entry point

 +1       ;change short description of existing clinic codes

           DO UPDATE

 +2        DO BMES^XPDUTL("Update complete")

 +3       ;

 +4        QUIT 

 +5       ;

UPDATE    ;changing short description of existing entries

 +1       ;ECXREC is in format: code^short description

 +2       ;

 +3        NEW ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC,ECXERR

 +4       ;

 +5        DO BMES^XPDUTL(">>>Updating entries in the NATIONAL CLINIC (728.441) file...")

 +6       ;

 +7        FOR ECXI=1:1

               SET ECXREC=$PIECE($TEXT(UPDCLIN+ECXI),";;",2)

               if ECXREC="QUIT"

                   QUIT 

               Begin DoDot:1

 +8                SET ECXCODE=$PIECE(ECXREC,"^")

                   SET ECXDESC=$PIECE(ECXREC,"^",2)

 +9                SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ECXERR")

 +10               IF 'ECXIEN

                       Begin DoDot:2

 +11                       DO BMES^XPDUTL(">>>....Unable to find code: "_ECXCODE_".")

 +12                       DO BMES^XPDUTL("*** Please contact support for assistance. ***")

                       End DoDot:2

                       QUIT 

 +13               KILL FDA

 +14               SET FDA(728.441,ECXIEN_",",1)=ECXDESC

 +15               DO FILE^DIE(,"FDA","ECXERR")

 +16               IF '$DATA(ECXERR)

                       DO BMES^XPDUTL(">>>...."_ECXCODE_" - "_$PIECE(ECXREC,U,2)_" updated")

 +17               IF $DATA(ECXERR)

                       DO BMES^XPDUTL(">>>....Unable to update code "_ECXCODE_".")

                       Begin DoDot:2

 +18                       DO BMES^XPDUTL("*** Please contact support for assistance. ***")

                       End DoDot:2

               End DoDot:1

 +19      ;

 +20       QUIT 

 +21      ;

UPDCLIN   ;Contains the NATIONAL CLINIC entry description to be updated

 +1       ;;HDHC^HIH Step Down

 +2       ;;SCQC^TELESTROKE

 +3       ;;WCGC^Adv Care Pln Grp

 +4       ;;QUIT