ECX3P179 ;ALB/TXH - NATIONAL CLINIC (#728.441) File Update; Jun 17, 2020@10:00
;;3.0;DSS EXTRACTS;**179**;Dec 22, 1997;Build 1
;
; Post-init routine updating SHORT DESCRIPTION (#1) in the
; NATIONAL CLINIC (#728.441) file for FY21 CHAR4 code changes,
; effective 10/1/2020.
;
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
;;CDVC^Virtual Medical Center (VMC)
;;NASQ^Disruptive Behavior Clinic
;;PDSC^CHAR4 COUNCIL
;;CGQC^CHAR4 COUNCIL
;;MANT^CHAR4 COUNCIL
;;MMMT^CHAR4 COUNCIL
;;NAHL^CHAR4 COUNCIL
;;PILA^CHAR4 COUNCIL
;;REIK^CHAR4 COUNCIL
;;TPHT^CHAR4 COUNCIL
;;MDTN^Meditation, Mantram Repetition, Mindfulness (not MBSR)
;;MPAT^Movement Approaches
;;TAIC^Tai Chi/Qi Gong
;;WCJC^Biofield Approaches
;;DEMT^My VA Images App
;;DEUC^Tele Urgent Care PA
;;DMUC^Tele Urgent Care MD
;;PNUC^Tele Urgent Care NP
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P179 1945 printed Dec 13, 2024@01:50:33 Page 2
ECX3P179 ;ALB/TXH - NATIONAL CLINIC (#728.441) File Update; Jun 17, 2020@10:00
+1 ;;3.0;DSS EXTRACTS;**179**;Dec 22, 1997;Build 1
+2 ;
+3 ; Post-init routine updating SHORT DESCRIPTION (#1) in the
+4 ; NATIONAL CLINIC (#728.441) file for FY21 CHAR4 code changes,
+5 ; effective 10/1/2020.
+6 ;
+7 QUIT
+8 ;
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 ;;CDVC^Virtual Medical Center (VMC)
+2 ;;NASQ^Disruptive Behavior Clinic
+3 ;;PDSC^CHAR4 COUNCIL
+4 ;;CGQC^CHAR4 COUNCIL
+5 ;;MANT^CHAR4 COUNCIL
+6 ;;MMMT^CHAR4 COUNCIL
+7 ;;NAHL^CHAR4 COUNCIL
+8 ;;PILA^CHAR4 COUNCIL
+9 ;;REIK^CHAR4 COUNCIL
+10 ;;TPHT^CHAR4 COUNCIL
+11 ;;MDTN^Meditation, Mantram Repetition, Mindfulness (not MBSR)
+12 ;;MPAT^Movement Approaches
+13 ;;TAIC^Tai Chi/Qi Gong
+14 ;;WCJC^Biofield Approaches
+15 ;;DEMT^My VA Images App
+16 ;;DEUC^Tele Urgent Care PA
+17 ;;DMUC^Tele Urgent Care MD
+18 ;;PNUC^Tele Urgent Care NP
+19 ;;QUIT
