ECX3P176.m

ECX3P176 ;ALB/TXH - NATIONAL CLINIC (#728.441) File Update; Feb 05, 2020@13:46

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

 ;

 ; Post-init routine updating SHORT DESCRIPTION (#1) in the 

 ; NATIONAL CLINIC (#728.441) file for Mid FY20 CHAR4 code

 ; changes, effective 4/1/2020.

 ;

 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

 ;;DMAC^CRH TMH Telemental Health

 ;;DMDC^CRH Psychologist

 ;;DMEC^CRH Social Worker

 ;;DMFC^CRH RN/LPN

 ;;DMGC^CRH NP

 ;;DMJC^CRH Pharmacist

 ;;DMKC^CRH MD/DO

 ;;DMLC^CRH PA

 ;;DMPC^ATLAS Community Non-Count

 ;;DMQC^CRH MMU

 ;;DMRC^CRH Spoke (Patient) Site

 ;;DMSC^CRH Group/SMA

 ;;WCUC^Telewound Care

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECX3P176   1745     printed  Apr 09, 2024@20:58:49                                                                                                                                                                                                    Page 2

ECX3P176  ;ALB/TXH - NATIONAL CLINIC (#728.441) File Update; Feb 05, 2020@13:46

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

 +2       ;

 +3       ; Post-init routine updating SHORT DESCRIPTION (#1) in the 

 +4       ; NATIONAL CLINIC (#728.441) file for Mid FY20 CHAR4 code

 +5       ; changes, effective 4/1/2020.

 +6       ;

 +7        QUIT 

 +8       ;

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       ;;DMAC^CRH TMH Telemental Health

 +2       ;;DMDC^CRH Psychologist

 +3       ;;DMEC^CRH Social Worker

 +4       ;;DMFC^CRH RN/LPN

 +5       ;;DMGC^CRH NP

 +6       ;;DMJC^CRH Pharmacist

 +7       ;;DMKC^CRH MD/DO

 +8       ;;DMLC^CRH PA

 +9       ;;DMPC^ATLAS Community Non-Count

 +10      ;;DMQC^CRH MMU

 +11      ;;DMRC^CRH Spoke (Patient) Site

 +12      ;;DMSC^CRH Group/SMA

 +13      ;;WCUC^Telewound Care

 +14      ;;QUIT