ECX386PT.m

ECX386PT ;ALB/JAM - PATCH ECX*3.0*86 Post-Init Rtn ; 07/13/05

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

 ;

 ;Post-init routine to add new entries to:

 ;           NATIONAL CLINIC file (#728.441)

 ;

EN ;

 ;- Add new entry to file 728.441

 ;      ECXREC is in format: code^short description

 ;

 ;

 N ECXFDA,ECXERR,ECXCODE,ECXREC,I,CNT0,CNT1

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

 D MES^XPDUTL(" ")

 S (CNT0,CNT1)=0

 ;

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

 ..S CNT1=CNT1+1

 .;- 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  Q

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

 ..S CNT0=CNT0+1

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

 .S CNT1=CNT1+1

 D MES^XPDUTL(" ")

 D MES^XPDUTL(" Done... Update to NATIONAL CLINIC File (#728.441).")

 D MES^XPDUTL("            "_$J(CNT0,3)_" new entries added.")

 D MES^XPDUTL("            "_$J(CNT1,3)_" were not added, already exist.")

 D MES^XPDUTL(" ")

 ;

 Q

 ;

NATCLIN ;- Contains the NATIONAL CLINIC entry to be added

 ;;MICM^MH INTENSIVE CASE MGMT

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECX386PT   1644     printed  Apr 09, 2024@20:55:33                                                                                                                                                                                                    Page 2

ECX386PT  ;ALB/JAM - PATCH ECX*3.0*86 Post-Init Rtn ; 07/13/05

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

 +2       ;

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

 +4       ;           NATIONAL CLINIC file (#728.441)

 +5       ;

EN        ;

 +1       ;- Add new entry to file 728.441

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

 +3       ;

 +4       ;

 +5        NEW ECXFDA,ECXERR,ECXCODE,ECXREC,I,CNT0,CNT1

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

 +7        DO MES^XPDUTL(" ")

 +8        SET (CNT0,CNT1)=0

 +9       ;

 +10      ;- Get NATIONAL CLINIC record

 +11       FOR I=1:1

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

               if ECXREC="QUIT"

                   QUIT 

               Begin DoDot:1

 +12      ;

 +13      ;- National Clinic code

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

 +15      ;

 +16      ;- Quit w/error message if entry already exists in file #728.441

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

                       Begin DoDot:2

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

 +19                       SET CNT1=CNT1+1

                       End DoDot:2

                       QUIT 

 +20      ;- Setup field values of new entry

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

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

 +23      ;

 +24      ;- Add new entry to file #728.441

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

 +26      ;

 +27               IF '$DATA(ECXERR)

                       Begin DoDot:2

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

 +29                       SET CNT0=CNT0+1

                       End DoDot:2

                       QUIT 

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

 +31               SET CNT1=CNT1+1

               End DoDot:1

 +32       DO MES^XPDUTL(" ")

 +33       DO MES^XPDUTL(" Done... Update to NATIONAL CLINIC File (#728.441).")

 +34       DO MES^XPDUTL("            "_$JUSTIFY(CNT0,3)_" new entries added.")

 +35       DO MES^XPDUTL("            "_$JUSTIFY(CNT1,3)_" were not added, already exist.")

 +36       DO MES^XPDUTL(" ")

 +37      ;

 +38       QUIT 

 +39      ;

NATCLIN   ;- Contains the NATIONAL CLINIC entry to be added

 +1       ;;MICM^MH INTENSIVE CASE MGMT

 +2       ;;QUIT