ECX135PT ;ALB/BP - PATCH ECX*3.0*135 Post-Init Rtn ; 11/24/09 2:11pm
;;3.0;DSS EXTRACTS;**135**;Dec 22, 1997;Build 7
;
;Post-init routine to add new entries to:
;
; NATIONAL CLINIC file (#728.441)
;
;
Q
EN ;Routine Entry Point
D POST1 ;Add new Clinic codes
D POST2 ;Change short description of existing clinic code
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
;
POST2 ;
N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,I
F I=1:1 S ECXREC=$P($T(NATCLIND+I),";;",2) Q:ECXREC="QUIT" D
.S ECXCODE=$P(ECXREC,"^"),ECXDESC=$P(ECXREC,"^",2)
.S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
.S DIE="^ECX(728.441,",DA=ECXIEN,DR="1///^S X=ECXDESC"
.D ^DIE
;
NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
;;ACUP^Acupuncture
;;BIOF^Biofeedback
;;CBHT^Cognitive Behavioral Therapy
;;CHAP^Chaplain
;;DEMT^Dementia-MH Therapist
;;DEPS^Dementia-Psychologist
;;ECOE^Epilepsy Center of Excellence
;;GIMA^Guided Imagery
;;HYPN^Hypnotherapy
;;MANT^Mantram Repetition
;;MBSR^Mindfulness-Based Stress Reduction
;;MDTN^Meditation
;;MHMT^Mental Health-MH Therapist
;;MHPS^Mental Health-Psychologist
;;MMMT^Multiple CoMorbidities-MH Therapist
;;MMPS^Multiple CoMorbidities-Psychologist
;;MSCE^MS Center of Excellence
;;MSGT^Massage therapy
;;NAHL^Native American healing
;;NDTR^Nutrition Diet Tech Registered
;;NUDT^Nutrition Diet Tech
;;NUTR^Nutrition Staff
;;PADR^PADRECC
;;PILA^Pilates
;;PLMT^Palliative Care-MH Therapist
;;PLPS^Palliative Care-Psychologist
;;RFLX^Reflexology
;;RLXT^Relaxation techniques
;;TAIC^Tai chi
;;TPHT^Therapeutic or healing touch
;;YOGA^Yoga
;;DTMV^Diet Tech-MOVE
;;NUMV^Nutritionist-MOVE
;;RDMV^Registered Dietitian-MOVE
;;RDNU^Nutrition Registered Dietitian
;;QUIT
NATCLIND ;- Contains the NATIONAL CLINIC entry description to be updated
;;CNSZ^E-Consult
;;CPRZ^SCAN-ECHO
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX135PT 3045 printed Oct 16, 2024@17:50:26 Page 2
ECX135PT ;ALB/BP - PATCH ECX*3.0*135 Post-Init Rtn ; 11/24/09 2:11pm
+1 ;;3.0;DSS EXTRACTS;**135**;Dec 22, 1997;Build 7
+2 ;
+3 ;Post-init routine to add new entries to:
+4 ;
+5 ; NATIONAL CLINIC file (#728.441)
+6 ;
+7 ;
+8 QUIT
EN ;Routine Entry Point
+1 ;Add new Clinic codes
DO POST1
+2 ;Change short description of existing clinic code
DO POST2
+3 QUIT
+4 ;
+5 ;
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 ;
POST2 ;
+1 NEW ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,I
+2 FOR I=1:1
SET ECXREC=$PIECE($TEXT(NATCLIND+I),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+3 SET ECXCODE=$PIECE(ECXREC,"^")
SET ECXDESC=$PIECE(ECXREC,"^",2)
+4 SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
+5 SET DIE="^ECX(728.441,"
SET DA=ECXIEN
SET DR="1///^S X=ECXDESC"
+6 DO ^DIE
End DoDot:1
+7 ;
NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
+1 ;;ACUP^Acupuncture
+2 ;;BIOF^Biofeedback
+3 ;;CBHT^Cognitive Behavioral Therapy
+4 ;;CHAP^Chaplain
+5 ;;DEMT^Dementia-MH Therapist
+6 ;;DEPS^Dementia-Psychologist
+7 ;;ECOE^Epilepsy Center of Excellence
+8 ;;GIMA^Guided Imagery
+9 ;;HYPN^Hypnotherapy
+10 ;;MANT^Mantram Repetition
+11 ;;MBSR^Mindfulness-Based Stress Reduction
+12 ;;MDTN^Meditation
+13 ;;MHMT^Mental Health-MH Therapist
+14 ;;MHPS^Mental Health-Psychologist
+15 ;;MMMT^Multiple CoMorbidities-MH Therapist
+16 ;;MMPS^Multiple CoMorbidities-Psychologist
+17 ;;MSCE^MS Center of Excellence
+18 ;;MSGT^Massage therapy
+19 ;;NAHL^Native American healing
+20 ;;NDTR^Nutrition Diet Tech Registered
+21 ;;NUDT^Nutrition Diet Tech
+22 ;;NUTR^Nutrition Staff
+23 ;;PADR^PADRECC
+24 ;;PILA^Pilates
+25 ;;PLMT^Palliative Care-MH Therapist
+26 ;;PLPS^Palliative Care-Psychologist
+27 ;;RFLX^Reflexology
+28 ;;RLXT^Relaxation techniques
+29 ;;TAIC^Tai chi
+30 ;;TPHT^Therapeutic or healing touch
+31 ;;YOGA^Yoga
+32 ;;DTMV^Diet Tech-MOVE
+33 ;;NUMV^Nutritionist-MOVE
+34 ;;RDMV^Registered Dietitian-MOVE
+35 ;;RDNU^Nutrition Registered Dietitian
+36 ;;QUIT
NATCLIND ;- Contains the NATIONAL CLINIC entry description to be updated
+1 ;;CNSZ^E-Consult
+2 ;;CPRZ^SCAN-ECHO
+3 ;;QUIT
