ECX3P193 ;MNTVBB/JWB - NATIONAL CLINIC (#728.441) File Update; JAN 10, 2025
;;3.0;DSS EXTRACTS;**193**;Dec 22, 1997;Build 5
;;Per VA Directive 6402, this routine should not be modified.
;
; This routine is used as a post-init in a KIDS build to
; update the NATIONAL CLINIC (#728.441) file for FY25 Mid-Year.
;
; Reference(s) to $$FIND1^DIC supported by ICR# 2051
; Reference(s) to FILE^DIE supported by ICR# 2053
; Reference(s) to UPDATE^DIE supported by ICR# 2053
; Reference(s) to BMES^XPDUTL supported by ICR# 10141
; Reference(s) to MES^XPDUTL supported by ICR# 10141
;
Q
;
POST ;routine entry point
;
; Start of Install
D BMES^XPDUTL("Update NATIONAL CLINIC (#728.441) file start.")
N ECX193FILES
S ECX193FILE=""
S ECX193FILES="728.441"
S ECXCNT=0
F ECXCNT=1:1:$L(ECX193FILES,"^") D
. S ECX193FILE=$P(ECX193FILES,"^",ECXCNT)
. D GLBBKUP
. Q
D INACT ;inactivate code
D UPDATE ;change short description of existing clinic codes
D BMES^XPDUTL("Update complete.")
D MES^XPDUTL("")
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
;
INACT ;adding inactivation date to existing clinics
N ECXCODE,ECXDATE,ECXIEN,DIE,DA,DR,ECXI
D BMES^XPDUTL(">>>Inactivating entry in the NATIONAL CLINIC (728.441) file..")
F ECXI=1:1 S ECXREC=$P($T(INCLIN+ECXI),";;",2) Q:ECXREC="QUIT" D
.S ECXCODE=$P(ECXREC,"^"),ECXDATE=$P(ECXREC,"^",2)
.S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
.I 'ECXIEN D Q
..D BMES^XPDUTL(">>>....Unable to inactivate "_ECXCODE_" "_$P(ECXREC,U,2)_".")
..D BMES^XPDUTL(">>>....Contact support for assistance")
.S DIE="^ECX(728.441,",DA=ECXIEN,DR="3///^S X=ECXDATE"
.D ^DIE
.D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" inactivated")
Q
;
GLBBKUP ; XTMP Backup of file(s)
S ECXBKUPNDE="ECX*3.0*193-Update NATIONAL CLINIC Mid Year 2025 Char4 (#728.441)"
S ^XTMP("ECX3P193",0)=$$FMADD^XLFDT(DT,120)_"^"_DT_"^"_ECXBKUPNDE
M ^XTMP("ECX3P193",ECX193FILE,$H)=^ECX(ECX193FILE)
Q
;
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
;;CDBC^CRH PCMHI CoCM
;;CDFC^CRH VA Health Connect VCV (Provider) Hub Side
;;EXPX^Military Environmental Exposure (MEE)
;;QUIT
;
INCLIN ;contains the NATIONAL CLINIC entry inactivation date
;;CGCC^3250401
;;CGPA^3250401
;;CGRD^3250401
;;CGSW^3250401
;;CNSR^3250401
;;CSCL^3250401
;;CSCT^3250401
;;DECC^3250401
;;DENP^3250401
;;DEPT^3250401
;;DERD^3250401
;;DERN^3250401
;;DESC^3250401
;;DESW^3250401
;;DMPC^3250401
;;DMPT^3250401
;;DMSW^3250401
;;FDLC^3250401
;;GLDV^3250401
;;GLDX^3250401
;;GLDY^3250401
;;PLTW^3250401
;;PLTX^3250401
;;PLTY^3250401
;;PLTZ^3250401
;;SVRW^3250401
;;SVRX^3250401
;;SVRY^3250401
;;SVRZ^3250401
;;YCBC^3250401
;;YCPX^3250401
;;YELT^3250401
;;YELU^3250401
;;YELV^3250401
;;YELW^3250401
;;YELX^3250401
;;YELY^3250401
;;QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P193 3786 printed Aug 26, 2025@22:06:32 Page 2
ECX3P193 ;MNTVBB/JWB - NATIONAL CLINIC (#728.441) File Update; JAN 10, 2025
+1 ;;3.0;DSS EXTRACTS;**193**;Dec 22, 1997;Build 5
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine is used as a post-init in a KIDS build to
+5 ; update the NATIONAL CLINIC (#728.441) file for FY25 Mid-Year.
+6 ;
+7 ; Reference(s) to $$FIND1^DIC supported by ICR# 2051
+8 ; Reference(s) to FILE^DIE supported by ICR# 2053
+9 ; Reference(s) to UPDATE^DIE supported by ICR# 2053
+10 ; Reference(s) to BMES^XPDUTL supported by ICR# 10141
+11 ; Reference(s) to MES^XPDUTL supported by ICR# 10141
+12 ;
+13 QUIT
+14 ;
POST ;routine entry point
+1 ;
+2 ; Start of Install
+3 DO BMES^XPDUTL("Update NATIONAL CLINIC (#728.441) file start.")
+4 NEW ECX193FILES
+5 SET ECX193FILE=""
+6 SET ECX193FILES="728.441"
+7 SET ECXCNT=0
+8 FOR ECXCNT=1:1:$LENGTH(ECX193FILES,"^")
Begin DoDot:1
+9 SET ECX193FILE=$PIECE(ECX193FILES,"^",ECXCNT)
+10 DO GLBBKUP
+11 QUIT
End DoDot:1
+12 ;inactivate code
DO INACT
+13 ;change short description of existing clinic codes
DO UPDATE
+14 DO BMES^XPDUTL("Update complete.")
+15 DO MES^XPDUTL("")
+16 QUIT
+17 ;
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 ;
INACT ;adding inactivation date to existing clinics
+1 NEW ECXCODE,ECXDATE,ECXIEN,DIE,DA,DR,ECXI
+2 DO BMES^XPDUTL(">>>Inactivating entry in the NATIONAL CLINIC (728.441) file..")
+3 FOR ECXI=1:1
SET ECXREC=$PIECE($TEXT(INCLIN+ECXI),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+4 SET ECXCODE=$PIECE(ECXREC,"^")
SET ECXDATE=$PIECE(ECXREC,"^",2)
+5 SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
+6 IF 'ECXIEN
Begin DoDot:2
+7 DO BMES^XPDUTL(">>>....Unable to inactivate "_ECXCODE_" "_$PIECE(ECXREC,U,2)_".")
+8 DO BMES^XPDUTL(">>>....Contact support for assistance")
End DoDot:2
QUIT
+9 SET DIE="^ECX(728.441,"
SET DA=ECXIEN
SET DR="3///^S X=ECXDATE"
+10 DO ^DIE
+11 DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" inactivated")
End DoDot:1
+12 QUIT
+13 ;
GLBBKUP ; XTMP Backup of file(s)
+1 SET ECXBKUPNDE="ECX*3.0*193-Update NATIONAL CLINIC Mid Year 2025 Char4 (#728.441)"
+2 SET ^XTMP("ECX3P193",0)=$$FMADD^XLFDT(DT,120)_"^"_DT_"^"_ECXBKUPNDE
+3 MERGE ^XTMP("ECX3P193",ECX193FILE,$HOROLOG)=^ECX(ECX193FILE)
+4 QUIT
+5 ;
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
+1 ;;CDBC^CRH PCMHI CoCM
+2 ;;CDFC^CRH VA Health Connect VCV (Provider) Hub Side
+3 ;;EXPX^Military Environmental Exposure (MEE)
+4 ;;QUIT
+5 ;
INCLIN ;contains the NATIONAL CLINIC entry inactivation date
+1 ;;CGCC^3250401
+2 ;;CGPA^3250401
+3 ;;CGRD^3250401
+4 ;;CGSW^3250401
+5 ;;CNSR^3250401
+6 ;;CSCL^3250401
+7 ;;CSCT^3250401
+8 ;;DECC^3250401
+9 ;;DENP^3250401
+10 ;;DEPT^3250401
+11 ;;DERD^3250401
+12 ;;DERN^3250401
+13 ;;DESC^3250401
+14 ;;DESW^3250401
+15 ;;DMPC^3250401
+16 ;;DMPT^3250401
+17 ;;DMSW^3250401
+18 ;;FDLC^3250401
+19 ;;GLDV^3250401
+20 ;;GLDX^3250401
+21 ;;GLDY^3250401
+22 ;;PLTW^3250401
+23 ;;PLTX^3250401
+24 ;;PLTY^3250401
+25 ;;PLTZ^3250401
+26 ;;SVRW^3250401
+27 ;;SVRX^3250401
+28 ;;SVRY^3250401
+29 ;;SVRZ^3250401
+30 ;;YCBC^3250401
+31 ;;YCPX^3250401
+32 ;;YELT^3250401
+33 ;;YELU^3250401
+34 ;;YELV^3250401
+35 ;;YELW^3250401
+36 ;;YELX^3250401
+37 ;;YELY^3250401
+38 ;;QUIT
+39 ;
