ECX3P168.m

ECX3P168 ;ALB/DE - NATIONAL CLINIC (#728.441) File Update;11/13/17

 ;;3.0;DSS EXTRACTS;**168**;Dec 22, 1997;Build 1

 ;

 ;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

 ;;CBHT^CHAR4 COUNCIL

 ;;DEMC^CHAR4 COUNCIL

 ;;DMDC^V-IMPACT Psychologist

 ;;DMEC^V-IMPACT Social Worker

 ;;DMFC^V-IMPACT RN/LPN

 ;;DMGC^V-IMPACT Nurse Practitioner

 ;;DMJC^V-IMPACT Pharmacist

 ;;DMKC^V-IMPACT MD/DO

 ;;DMLC^V-IMPACT PA

 ;;DMPC^V-IMPACT Contract MD/DO

 ;;DMQC^V-IMPACT Contract NP

 ;;DMRC^V-IMPACT Spoke (Patient) Side

 ;;DMSC^V-IMPACT Other

 ;;HDQC^Homeless Vets Street Outreach

 ;;HTSC^HURRICANE IRMA CVT SERVICES

 ;;HTUC^HURRICANE HARVEY CVT SERVICES

 ;;PNJC^Open Access

 ;;RHVC^Traveling Vets Coordinator

 ;;WCEC^Whole Health Education Group

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECX3P168   1921     printed  Apr 09, 2024@20:55:15                                                                                                                                                                                                    Page 2

ECX3P168  ;ALB/DE - NATIONAL CLINIC (#728.441) File Update;11/13/17

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

 +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       ;;CBHT^CHAR4 COUNCIL

 +2       ;;DEMC^CHAR4 COUNCIL

 +3       ;;DMDC^V-IMPACT Psychologist

 +4       ;;DMEC^V-IMPACT Social Worker

 +5       ;;DMFC^V-IMPACT RN/LPN

 +6       ;;DMGC^V-IMPACT Nurse Practitioner

 +7       ;;DMJC^V-IMPACT Pharmacist

 +8       ;;DMKC^V-IMPACT MD/DO

 +9       ;;DMLC^V-IMPACT PA

 +10      ;;DMPC^V-IMPACT Contract MD/DO

 +11      ;;DMQC^V-IMPACT Contract NP

 +12      ;;DMRC^V-IMPACT Spoke (Patient) Side

 +13      ;;DMSC^V-IMPACT Other

 +14      ;;HDQC^Homeless Vets Street Outreach

 +15      ;;HTSC^HURRICANE IRMA CVT SERVICES

 +16      ;;HTUC^HURRICANE HARVEY CVT SERVICES

 +17      ;;PNJC^Open Access

 +18      ;;RHVC^Traveling Vets Coordinator

 +19      ;;WCEC^Whole Health Education Group

 +20      ;;QUIT