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
;
Q
;
EN ;routine entry point
D ADDNEW ;add new entries
D UPDATE ;change short description of existing clinic codes
D BMES^XPDUTL("Update complete")
;
Q
;
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. ***")
;
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. ***")
.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. ***")
;
Q
;
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 Dec 13, 2024@01:50:28 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
