Routine: ECX3P159

ECX3P159 ;ALB/DE - ECX*3.0*159 Post-Init RTN;09/18/15

 ;;3.0;DSS EXTRACTS;**159**;Dec 22, 1997;Build 2

 ;Post-init routine adding and updating entries in

 ;the NATIONAL CLINIC (#728.441) file

EN ;routine entry point

 D ADDNEW ;add new entries

 D UPDATE ;change short description of existing clinic codes

 D BMES^XPDUTL("Update complete")

ADDNEW ;Add new entries to file 728.441

 ;ECXREC is in format: code^short description

 N ECXFDA,ECXCODE,ECXREC,ECXI,ECXERR

 D BMES^XPDUTL(">>>Adding entries to the NATIONAL CLINIC (728.441) file..")

 ;-get National Clinic record

 F ECXI=1:1 S ECXREC=$P($T(ADDCLIN+ECXI),";;",2) Q:ECXREC="QUIT"  D

.;

 .;-get National Clinic Code

 .S ECXCODE=$P(ECXREC,"^")

.;

 .;-quit w/error message if entry already exists in file #728.441

 .I $$FIND1^DIC(728.441,"","X",ECXCODE) D  Q

 ..D BMES^XPDUTL(">>>..."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, code already exists.")

 ..D BMES^XPDUTL("*** Please contact support for assistance. ***")

.;

 .;-setup field values of new entry

 .S ECXFDA(728.441,"+1,",.01)=ECXCODE

 .S ECXFDA(728.441,"+1,",1)=$P(ECXREC,"^",2)

.;

 .;-add new entry to file #728.441

 .D UPDATE^DIE("E","ECXFDA","","ECXERR")

.;

 .I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" - "_$P(ECXREC,U,2)_" added to file.")

 .I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" to the file.") D

 ..D BMES^XPDUTL("*** Please contact support for assistance. ***")

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. ***")

  .N 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. ***")

ADDCLIN ;Contains the NATIONAL CLINIC entries to be added

 ;;LVL6^Mobile Medical Unit 6

 ;;LVL7^Mobile Medical Unit 7

 ;;LVL8^Mobile Medical Unit 8

 ;;LVL9^Mobile Medical Unit 9

 ;;QUIT

UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated

 ;;LVL1^Mobile Medical Unit 1

 ;;LVL2^Mobile Medical Unit 2

 ;;LVL3^Mobile Medical Unit 3

 ;;LVL4^Mobile Medical Unit 4

 ;;LVL5^Mobile Medical Unit 5

 ;;PNPC^PACT CVT-H Physician

 ;;PNQC^PACT CVT-H Physician Assistant

 ;;PNRC^PACT CVT-H Nurse Practitioner

 ;;PNSC^PACT CVT-H Nurse

 ;;RDNU^Radiology Oncology Clinic

 ;;SNRC^VA Provider & Pt at NonVAFacility

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P159   3048     printed  Mar 13, 2025@20:55                                                                                                                                                                                                       Page 2

ECX3P159  ;ALB/DE - ECX*3.0*159 Post-Init RTN;09/18/15

 +1       ;;3.0;DSS EXTRACTS;**159**;Dec 22, 1997;Build 2

 +2       ;

 +3       ;Post-init routine adding and updating entries in

 +4       ;the NATIONAL CLINIC (#728.441) file

 +5       ;

 +6        QUIT

 +7       ;

EN        ;routine entry point

 +1       ;add new entries

           DO ADDNEW

 +2       ;change short description of existing clinic codes

           DO UPDATE

 +3        DO BMES^XPDUTL("Update complete")

 +4       ;

 +5        QUIT

 +6       ;

ADDNEW    ;Add new entries to file 728.441

 +1       ;ECXREC is in format: code^short description

 +2       ;

 +3        NEW ECXFDA,ECXCODE,ECXREC,ECXI,ECXERR

 +4       ;

 +5        DO BMES^XPDUTL(">>>Adding entries to the NATIONAL CLINIC (728.441) file..")

 +6       ;

 +7       ;-get National Clinic record

 +8        FOR ECXI=1:1

               SET ECXREC=$PIECE($TEXT(ADDCLIN+ECXI),";;",2)

               if ECXREC="QUIT"

                   QUIT

               Begin DoDot:1

 +9       ;

 +10      ;-get National Clinic Code

 +11               SET ECXCODE=$PIECE(ECXREC,"^")

 +12      ;

 +13      ;-quit w/error message if entry already exists in file #728.441

 +14               IF $$FIND1^DIC(728.441,"","X",ECXCODE)

                       Begin DoDot:2

 +15                       DO BMES^XPDUTL(">>>..."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" not added, code already exists.")

 +16                       DO BMES^XPDUTL("*** Please contact support for assistance. ***")

                       End DoDot:2

                       QUIT

 +17      ;

 +18      ;-setup field values of new entry

 +19               SET ECXFDA(728.441,"+1,",.01)=ECXCODE

 +20               SET ECXFDA(728.441,"+1,",1)=$PIECE(ECXREC,"^",2)

 +21      ;

 +22      ;-add new entry to file #728.441

 +23               DO UPDATE^DIE("E","ECXFDA","","ECXERR")

 +24      ;

 +25               IF '$DATA(ECXERR)

                       DO BMES^XPDUTL(">>>...."_ECXCODE_" - "_$PIECE(ECXREC,U,2)_" added to file.")

 +26               IF $DATA(ECXERR)

                       DO BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" to the file.")

                       Begin DoDot:2

 +27                       DO BMES^XPDUTL("*** Please contact support for assistance. ***")

                       End DoDot:2

               End DoDot:1

 +28      ;

 +29       QUIT

 +30      ;

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               NEW 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      ;

ADDCLIN   ;Contains the NATIONAL CLINIC entries to be added

 +1       ;;LVL6^Mobile Medical Unit 6

 +2       ;;LVL7^Mobile Medical Unit 7

 +3       ;;LVL8^Mobile Medical Unit 8

 +4       ;;LVL9^Mobile Medical Unit 9

 +5       ;;QUIT

 +6       ;

UPDCLIN   ;Contains the NATIONAL CLINIC entry description to be updated

 +1       ;;LVL1^Mobile Medical Unit 1

 +2       ;;LVL2^Mobile Medical Unit 2

 +3       ;;LVL3^Mobile Medical Unit 3

 +4       ;;LVL4^Mobile Medical Unit 4

 +5       ;;LVL5^Mobile Medical Unit 5

 +6       ;;PNPC^PACT CVT-H Physician

 +7       ;;PNQC^PACT CVT-H Physician Assistant

 +8       ;;PNRC^PACT CVT-H Nurse Practitioner

 +9       ;;PNSC^PACT CVT-H Nurse

 +10      ;;RDNU^Radiology Oncology Clinic

 +11      ;;SNRC^VA Provider & Pt at NonVAFacility

 +12      ;;QUIT

ECX3P159.m