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 ---[H[J[2J[HECX386PT 1644 printed Dec 13, 2024@01:50:06 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
