Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECX3P186

ECX3P186.m

Go to the documentation of this file. 
  1. ECX3P186 ;MNTVBB/DMR - NATIONAL CLINIC (#728.441) File Update; FEB 1, 2023@14:42
  1.  ;;3.0;DSS EXTRACTS;**186**;Dec 22, 1997;Build 2
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Post-init routine updating entries in the NATIONAL CLINIC (#728.441)
  1.  ; file for FY23 Mid-Year.
  1.  ;
  1.  ; Reference(s) to $$FIND1^DIC supported by ICR# 2051
  1.  ; Reference(s) to FILE^DIE supported by ICR# 2053
  1.  ; Reference(s) to UPDATE^DIE supported by ICR# 2053
  1.  ; Reference(s) to BMES^XPDUTL supported by ICR# 10141
  1.  ; Reference(s) to MES^XPDUTL supported by ICR# 10141
  1.  ;
  1.  Q
  1.  ;
  1. POST ;routine entry point
  1.  ;
  1.  D BMES^XPDUTL("Update NATIONAL CLINIC (#728.441) file starts.")
  1.  D ADD    ;add new code
  1.  D UPDATE ;change short description of existing clinic codes
  1.  D BMES^XPDUTL("Update complete.")
  1.  D MES^XPDUTL("")
  1.  ;
  1.  Q
  1.  ;
  1. ADD ; Add new code
  1.  ;
  1.  N ECXI,ECXREC,ECXNM,ECXCODE,ECXIEN,ECXERR
  1.  D BMES^XPDUTL(">>> Adding new CHAR4 code(s) to the NATIONAL CLINIC file (#728.441)...")
  1.  ;
  1.  F ECXI=1:1 S ECXREC=$P($T(ADDCLIN+ECXI),";;",2) Q:ECXREC="QUIT"  D
  1.  . S ECXNM=$P(ECXREC,U)     ;Name
  1.  . S ECXCODE=$P(ECXREC,U,2) ;Code
  1.  . ; check if new code already exists in file 728.441
  1.  . S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ECXERR")
  1.  . ; quit if error
  1.  . I $D(ECXERR) D  Q
  1.  . . D BMES^XPDUTL("       >> ... Unable to add CHAR4 code "_ECXCODE_" - "_ECXNM_" to file.")
  1.  . . D MES^XPDUTL("        >> ... "_$G(ECXERR("DIERR",1,"TEXT",1))_".")
  1.  . . D MES^XPDUTL("        >> ... Please contact support for assistance...")
  1.  . . K ECXERR
  1.  . ; if code already exists, quit
  1.  . I ECXIEN D  Q
  1.  . . D BMES^XPDUTL("    >> CHAR4 code "_ECXCODE_" - "_ECXNM_" already exists.")
  1.  . ; if code does not exist, add new entry
  1.  . ; set field values of new entry
  1.  . K ECXFDA
  1.  . S ECXFDA(728.441,"+1,",.01)=ECXCODE
  1.  . S ECXFDA(728.441,"+1,",1)=ECXNM
  1.  . ; add new entry
  1.  . D UPDATE^DIE("E","ECXFDA","","ECXERR")
  1.  . ; check if error
  1.  . I '$D(ECXERR) D
  1.  . . D BMES^XPDUTL("    >> CHAR4 Code "_ECXCODE_" - "_ECXNM_" added to file.")
  1.  . I $D(ECXERR) D
  1.  . . D BMES^XPDUTL("    >> ... Unable to add CHAR4 code "_ECXCODE_" "_ECXNM_" to file.")
  1.  . . D MES^XPDUTL("    >> ... "_$G(ECXERR("DIERR",1,"TEXT",1))_".")
  1.  . . D MES^XPDUTL("    >> ... Please contact support for assistance.")
  1.  . . ; clean out error array b4 processing next code
  1.  . . K ECXERR
  1.  ;
  1.  D BMES^XPDUTL(">>> Add new CHAR4 code(s) complete.")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. UPDATE ;changing short description of existing entries
  1.  ;ECXREC is in format: code^short description
  1.  ;
  1.  N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,ECXI,ECXREC,ECXERR
  1.  ;
  1.  D BMES^XPDUTL(">>> Updating entries in the NATIONAL CLINIC (728.441) file...")
  1.  ;
  1.  F ECXI=1:1 S ECXREC=$P($T(UPDCLIN+ECXI),";;",2) Q:ECXREC="QUIT"  D
  1.   .S ECXCODE=$P(ECXREC,"^"),ECXDESC=$P(ECXREC,"^",2)
  1.   .S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ECXERR")
  1.   .I 'ECXIEN D  Q
  1.   ..D BMES^XPDUTL(">>>....Unable to find code: "_ECXCODE_".")
  1.   ..D BMES^XPDUTL("*** Please contact support for assistance. ***")
  1.   .K FDA
  1.   .S FDA(728.441,ECXIEN_",",1)=ECXDESC
  1.   .D FILE^DIE(,"FDA","ECXERR")
  1.   .I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" - "_$P(ECXREC,U,2)_" updated")
  1.   .I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to update code "_ECXCODE_".") D
  1.   ..D BMES^XPDUTL("*** Please contact support for assistance. ***")
  1.  ;
  1.  Q
  1.  ;
  1. ADDCLIN ;Add new code
  1.  ;;QUIT
  1.  ;
  1. UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
  1.  ;;CGEC^CRH Environmental Registry
  1.  ;;CGLC^Long COVID Care
  1.  ;;CGTC^Care Coordination Review Team (CCRT)
  1.  ;;COLL^Primary Care MH Integration CoCM
  1.  ;;DEAC^Inpatient Pharmacist Anticoagulation Clinic
  1.  ;;DEBC^CRH Long COVID
  1.  ;;DEDC^CRH Low Vision OD
  1.  ;;DEEC^CRH BROS/CATIS
  1.  ;;DEFC^CRH BRS
  1.  ;;DEGC^Inpatient Geriatrics Pharmacist
  1.  ;;DELC^CRH VIST
  1.  ;;DEMC^CRH Registered Dietician
  1.  ;;DENC^CRH Registered Audiologist
  1.  ;;DEPC^PACT Pharmacy Clinics
  1.  ;;HDMC^Telemental Health Home Hospice
  1.  ;;HDPC^Inpatient Mental Health Pharmacist
  1.  ;;IDEC^Inpatient Pharmacist Antimicrobial Stewardship
  1.  ;;IDFC^Inpatient Pharmacist Cardiology Clinic
  1.  ;;IDGC^Inpatient Pharmacist Critical Care Clinic
  1.  ;;IDJC^Inpatient Pharmacist General MTM Services Clinic
  1.  ;;IDKC^Inpatient Pharmacist Infectious Disease Clinic
  1.  ;;IDLC^Inpatient Pharmacist Internal Medicine Clinic
  1.  ;;IDPC^Inpatient Meds Reconciliation/Discharge Counseling
  1.  ;;IDQC^Inpatient Pharmacist Nutrition Support Clinic
  1.  ;;IDRC^Inpatient Pharmacist Oncology Clinic
  1.  ;;IDUC^Inpatient Pharmacist Pharmacokinetics
  1.  ;;IDVC^Inpatient Pharmacist Spinal Cord Injury Clinic
  1.  ;;IDWC^Inpatient Pharmacist Surgery Clinic
  1.  ;;MPAX^Monkey Pox Vaccination Clinics
  1.  ;;POPP^Mental Health Integration CoCM
  1.  ;;XYEL^Integrated Mental Health for Specialty Clinics
  1.  ;;QUIT