ECX3P179.m

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 ---ECX3P179   1945     printed  Apr 09, 2024@20:57:31                                                                                                                                                                                                    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