- ECX3P176 ;ALB/TXH - NATIONAL CLINIC (#728.441) File Update; Feb 05, 2020@13:46
- ;;3.0;DSS EXTRACTS;**176**;Dec 22, 1997;Build 2
- ;
- ; Post-init routine updating SHORT DESCRIPTION (#1) in the
- ; NATIONAL CLINIC (#728.441) file for Mid FY20 CHAR4 code
- ; changes, effective 4/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
- ;;DMAC^CRH TMH Telemental Health
- ;;DMDC^CRH Psychologist
- ;;DMEC^CRH Social Worker
- ;;DMFC^CRH RN/LPN
- ;;DMGC^CRH NP
- ;;DMJC^CRH Pharmacist
- ;;DMKC^CRH MD/DO
- ;;DMLC^CRH PA
- ;;DMPC^ATLAS Community Non-Count
- ;;DMQC^CRH MMU
- ;;DMRC^CRH Spoke (Patient) Site
- ;;DMSC^CRH Group/SMA
- ;;WCUC^Telewound Care
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P176 1745 printed Apr 23, 2025@18:05 Page 2
- ECX3P176 ;ALB/TXH - NATIONAL CLINIC (#728.441) File Update; Feb 05, 2020@13:46
- +1 ;;3.0;DSS EXTRACTS;**176**;Dec 22, 1997;Build 2
- +2 ;
- +3 ; Post-init routine updating SHORT DESCRIPTION (#1) in the
- +4 ; NATIONAL CLINIC (#728.441) file for Mid FY20 CHAR4 code
- +5 ; changes, effective 4/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 ;;DMAC^CRH TMH Telemental Health
- +2 ;;DMDC^CRH Psychologist
- +3 ;;DMEC^CRH Social Worker
- +4 ;;DMFC^CRH RN/LPN
- +5 ;;DMGC^CRH NP
- +6 ;;DMJC^CRH Pharmacist
- +7 ;;DMKC^CRH MD/DO
- +8 ;;DMLC^CRH PA
- +9 ;;DMPC^ATLAS Community Non-Count
- +10 ;;DMQC^CRH MMU
- +11 ;;DMRC^CRH Spoke (Patient) Site
- +12 ;;DMSC^CRH Group/SMA
- +13 ;;WCUC^Telewound Care
- +14 ;;QUIT
