ECXP83PT.m

ECXP83PT ;ALB/ESD - PATCH ECX*3.0*83 Post-Init Rtn ; 12/1/04 1:00pm

 ;;3.0;DSS EXTRACTS;**83**;Dec 22, 1997

 ;

 ;Post-init routine to add new entries to:

 ;       

 ;           NATIONAL CLINIC file (#728.441)

 ;

 ;

EN D POST1

 Q

 ;

 ;

POST1 ;- Add new entry to file 728.441

 ;      ECXREC is in format: code^short description

 ;

 ;

 N ECXFDA,ECXERR,ECXCODE,ECXREC,I

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

 ;

 ;- Get NATIONAL CLINIC record

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

 .;

 .;- 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, entry already exists.")

 ..D BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")

 ..D MES^XPDUTL(">>> previous installation of this patch.")

 .;

 .;- 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_"  "_$P(ECXREC,U,2)_" to file.")

 ;

 Q

 ;

NATCLIN ;- Contains the NATIONAL CLINIC entry to be added

 ;;573L^PROV L V08 573 N.FLA/S.GA HCS

 ;;573M^PROV M V08 573 N.FLA/S.GA HCS

 ;;573N^PROV N V08 573 N.FLA/S.GA HCS

 ;;573O^PROV O V08 573 N.FLA/S.GA HCS

 ;;573P^PROV P V08 573 N.FLA/S.GA HCS

 ;;573Q^PROV Q V08 573 N.FLA/S.GA HCS

 ;;573R^PROV R V08 573 N.FLA/S.GA HCS

 ;;573S^PROV S V08 573 N.FLA/S.GA HCS

 ;;573T^PROV T V08 573 N.FLA/S.GA HCS

 ;;573U^PROV U V08 573 N.FLA/S.GA HCS

 ;;573V^PROV V V08 573 N.FLA/S.GA HCS

 ;;573W^PROV W V08 573 N.FLA/S.GA HCS

 ;;573X^PROV X V08 573 N.FLA/S.GA HCS

 ;;573Y^PROV Y V08 573 N.FLA/S.GA HCS

 ;;573Z^PROV Z V08 573 N.FLA/S.GA HCS

 ;;RENL^RENAL

 ;;GERI^GERIATRICS

 ;;HBPC^HOME BASED PRIMARY CARE

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECXP83PT   2121     printed  Apr 09, 2024@20:58:38                                                                                                                                                                                                    Page 2

ECXP83PT  ;ALB/ESD - PATCH ECX*3.0*83 Post-Init Rtn ; 12/1/04 1:00pm

 +1       ;;3.0;DSS EXTRACTS;**83**;Dec 22, 1997

 +2       ;

 +3       ;Post-init routine to add new entries to:

 +4       ;       

 +5       ;           NATIONAL CLINIC file (#728.441)

 +6       ;

 +7       ;

EN         DO POST1

 +1        QUIT 

 +2       ;

 +3       ;

POST1     ;- Add new entry to file 728.441

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

 +2       ;

 +3       ;

 +4        NEW ECXFDA,ECXERR,ECXCODE,ECXREC,I

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

 +6       ;

 +7       ;- Get NATIONAL CLINIC record

 +8        FOR I=1:1

               SET ECXREC=$PIECE($TEXT(NATCLIN+I),";;",2)

               if ECXREC="QUIT"

                   QUIT 

               Begin DoDot:1

 +9       ;

 +10      ;- 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, entry already exists.")

 +16                       DO BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")

 +17                       DO MES^XPDUTL(">>> previous installation of this patch.")

                       End DoDot:2

                       QUIT 

 +18      ;

 +19      ;- Setup field values of new entry

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

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

 +22      ;

 +23      ;- Add new entry to file #728.441

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

 +25      ;

 +26               IF '$DATA(ECXERR)

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

 +27               IF $DATA(ECXERR)

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

               End DoDot:1

 +28      ;

 +29       QUIT 

 +30      ;

NATCLIN   ;- Contains the NATIONAL CLINIC entry to be added

 +1       ;;573L^PROV L V08 573 N.FLA/S.GA HCS

 +2       ;;573M^PROV M V08 573 N.FLA/S.GA HCS

 +3       ;;573N^PROV N V08 573 N.FLA/S.GA HCS

 +4       ;;573O^PROV O V08 573 N.FLA/S.GA HCS

 +5       ;;573P^PROV P V08 573 N.FLA/S.GA HCS

 +6       ;;573Q^PROV Q V08 573 N.FLA/S.GA HCS

 +7       ;;573R^PROV R V08 573 N.FLA/S.GA HCS

 +8       ;;573S^PROV S V08 573 N.FLA/S.GA HCS

 +9       ;;573T^PROV T V08 573 N.FLA/S.GA HCS

 +10      ;;573U^PROV U V08 573 N.FLA/S.GA HCS

 +11      ;;573V^PROV V V08 573 N.FLA/S.GA HCS

 +12      ;;573W^PROV W V08 573 N.FLA/S.GA HCS

 +13      ;;573X^PROV X V08 573 N.FLA/S.GA HCS

 +14      ;;573Y^PROV Y V08 573 N.FLA/S.GA HCS

 +15      ;;573Z^PROV Z V08 573 N.FLA/S.GA HCS

 +16      ;;RENL^RENAL

 +17      ;;GERI^GERIATRICS

 +18      ;;HBPC^HOME BASED PRIMARY CARE

 +19      ;;QUIT