Routine: ECX3P171

ECX3P171 ;MNT/DTA - NATIONAL CLINIC (#728.441) File Update;04/25/18

 ;;3.0;DSS EXTRACTS;**171**;Dec 22, 1997;Build 7

 ;Post-init routine adding and updating entries in

 ;the NATIONAL CLINIC (#728.441) file

EN ;routine entry point

 D ADDNEW ;add new entries

 D UPDATE ;change short description of existing clinic codes

 D BMES^XPDUTL("Update complete")

ADDNEW ;Add new entries to file 728.441

 ;ECXREC is in format: code^short description

 N ECXFDA,ECXCODE,ECXREC,ECXI,ECXERR

 D BMES^XPDUTL(">>>Adding entries to the NATIONAL CLINIC (728.441) file..")

 ;-get National Clinic record

 F ECXI=1:1 S ECXREC=$P($T(ADDCLIN+ECXI),";;",2) Q:ECXREC="QUIT"  D

.;

 .;-get National Clinic Code

 .S ECXCODE=$P(ECXREC,"^")

.;

 .;-quit w/error message if entry already exists in file #728.441

 .I $$FIND1^DIC(728.441,"","X",ECXCODE) D  Q

 ..D BMES^XPDUTL(">>>..."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, code already exists.")

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

.;

 .;-setup field values of new entry

 .S ECXFDA(728.441,"+1,",.01)=ECXCODE

 .S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)

.;

 .;-add new entry to file #728.441

 .D UPDATE^DIE("E","ECXFDA","","ECXERR")

.;

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

 .I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" to the file.") D

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

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. ***")

  .N ECXFDA1

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

  .D FILE^DIE(,"ECXFDA1","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. ***")

ADDCLIN ;Contains the NATIONAL CLINIC entries to be added

 ;;CCSM^Chronic Condition Self-Management Group

 ;;ENDP^Endocrinology Pharmacist

 ;;GASP^Gastroenterology Pharmacist

 ;;GWFU^Gateway to Healthy Living - Follow-up

 ;;GWGR^Gateway to Healthy Living - Group

 ;;HBCG^Health Behavior Counseling Group

 ;;HBCI^Health Behavior Counseling Indiv

 ;;HIHP^Hospital in Home Pharmacist

 ;;MHIP^Pri Care MH Integration Pharmacist

 ;;NEPP^Nephrology Pharmacist

 ;;POPP^Population Management Pharmacist

 ;;RESP^Research Pharmacist

 ;;SUDP^Substance Use Disorder Pharmacist

 ;;TOCP^Transitions of Care Pharmacist

 ;;TRAP^Transplant Pharmacist

 ;;QUIT

UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated

 ;;DEMT^Telederm App Used

 ;;HTAC^Whole Health Partner Group

 ;;HTFC^Whole Health Partner Indiv

 ;;PDRC^Telecare NP

 ;;PDTC^Telecare PA

 ;;PDVC^Telecare MD/DO

 ;;RHQC^Rehab Rural Telehealth

 ;;WCDC^Whole Health Coaching Group

 ;;WCHC^Whole Health Coaching Indiv

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P171   3444     printed  Mar 13, 2025@20:55:08                                                                                                                                                                                                    Page 2

ECX3P171  ;MNT/DTA - NATIONAL CLINIC (#728.441) File Update;04/25/18

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

 +2       ;

 +3       ;Post-init routine adding and updating entries in

 +4       ;the NATIONAL CLINIC (#728.441) file

 +5       ;

 +6        QUIT

 +7       ;

EN        ;routine entry point

 +1       ;add new entries

           DO ADDNEW

 +2       ;change short description of existing clinic codes

           DO UPDATE

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

 +4       ;

 +5        QUIT

 +6       ;

ADDNEW    ;Add new entries to file 728.441

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

 +2       ;

 +3        NEW ECXFDA,ECXCODE,ECXREC,ECXI,ECXERR

 +4       ;

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

 +6       ;

 +7       ;-get National Clinic record

 +8        FOR ECXI=1:1

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

               if ECXREC="QUIT"

                   QUIT

               Begin DoDot:1

 +9       ;

 +10      ;-get National Clinic Code

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

 +12      ;

 +13      ;-quit w/error message if entry already exists in file #728.441

 +14               IF $$FIND1^DIC(728.441,"","X",ECXCODE)

                       Begin DoDot:2

 +15                       DO BMES^XPDUTL(">>>..."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" not added, code already exists.")

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

                       End DoDot:2

                       QUIT

 +17      ;

 +18      ;-setup field values of new entry

 +19               SET ECXFDA(728.441,"+1,",.01)=ECXCODE

 +20               SET ECXFDA(728.441,"+1,",1)=$PIECE(ECXREC,"^",2)

 +21      ;

 +22      ;-add new entry to file #728.441

 +23               DO UPDATE^DIE("E","ECXFDA","","ECXERR")

 +24      ;

 +25               IF '$DATA(ECXERR)

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

 +26               IF $DATA(ECXERR)

                       DO BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" to the file.")

                       Begin DoDot:2

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

                       End DoDot:2

               End DoDot:1

 +28      ;

 +29       QUIT

 +30      ;

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               NEW ECXFDA1

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

 +15               DO FILE^DIE(,"ECXFDA1","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      ;

ADDCLIN   ;Contains the NATIONAL CLINIC entries to be added

 +1       ;;CCSM^Chronic Condition Self-Management Group

 +2       ;;ENDP^Endocrinology Pharmacist

 +3       ;;GASP^Gastroenterology Pharmacist

 +4       ;;GWFU^Gateway to Healthy Living - Follow-up

 +5       ;;GWGR^Gateway to Healthy Living - Group

 +6       ;;HBCG^Health Behavior Counseling Group

 +7       ;;HBCI^Health Behavior Counseling Indiv

 +8       ;;HIHP^Hospital in Home Pharmacist

 +9       ;;MHIP^Pri Care MH Integration Pharmacist

 +10      ;;NEPP^Nephrology Pharmacist

 +11      ;;POPP^Population Management Pharmacist

 +12      ;;RESP^Research Pharmacist

 +13      ;;SUDP^Substance Use Disorder Pharmacist

 +14      ;;TOCP^Transitions of Care Pharmacist

 +15      ;;TRAP^Transplant Pharmacist

 +16      ;;QUIT

 +17      ;

UPDCLIN   ;Contains the NATIONAL CLINIC entry description to be updated

 +1       ;;DEMT^Telederm App Used

 +2       ;;HTAC^Whole Health Partner Group

 +3       ;;HTFC^Whole Health Partner Indiv

 +4       ;;PDRC^Telecare NP

 +5       ;;PDTC^Telecare PA

 +6       ;;PDVC^Telecare MD/DO

 +7       ;;RHQC^Rehab Rural Telehealth

 +8       ;;WCDC^Whole Health Coaching Group

 +9       ;;WCHC^Whole Health Coaching Indiv

 +10      ;;QUIT

ECX3P171.m