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

ECX3P165.m

Go to the documentation of this file.
  1. ECX3P165 ;ALB/DE - NATIONAL CLINIC (#728.441) File Update;09/13/16
  1. ;;3.0;DSS EXTRACTS;**165**;Dec 22, 1997;Build 1
  1. ;
  1. ;Post-init routine updating entries in
  1. ;the NATIONAL CLINIC (#728.441) file
  1. ;
  1. Q
  1. ;
  1. EN ;routine entry point
  1. D UPDATE ;change short description of existing clinic codes
  1. D BMES^XPDUTL("Update complete")
  1. ;
  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. UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
  1. ;;CDTC^Expressive Arts
  1. ;;CGQC^Qi Gong
  1. ;;DEMC^Eye Mvmnt Desensitiz&Reprocess
  1. ;;HTFC^Whole Health Partner
  1. ;;IACT^BFA Technique (not regular Acupuncture)
  1. ;;IDHC^Integrative Health Consult
  1. ;;MMMT^Mindfulness other than MBSR
  1. ;;MPAT^Movement Therapy
  1. ;;PNTC^Animal-Assisted Therapy
  1. ;;WCHC^Whole Health Coaching
  1. ;;QUIT