- ECX133PT ;ALB/BP - PATCH ECX*3.0*133 Post-Init Rtn ; 11/24/09 2:11pm
- ;;3.0;DSS EXTRACTS;**133**;Dec 22, 1997;Build 6
- ;
- ;Post-init routine to add new entries to:
- ;
- ; NATIONAL CLINIC file (#728.441)
- ;
- ;
- Q
- EN 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
- S ECXCODE="CGRP",ECXDESC="Caregiver Support Program"
- 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
- ;;CCPH^Critical Care Pharmacist
- ;;CDED^Cardiac Disease Education (CHF, etc)
- ;;CRRC^Cardiovascular Risk Reduction Pharmacist
- ;;DRPH^Dermatology Pharmacist
- ;;EDPH^Emergency Department Pharmacist
- ;;ESPH^ESA Pharmacist
- ;;HEPC^Hepatitis C Pharmacist
- ;;HIVD^HIV Pharmacist
- ;;IMPH^Internal Medicine Pharmacist
- ;;MREC^Medication Reconciliation Pharmacist
- ;;MTMP^Medication Therapy Management Pharmacist
- ;;NEUR^Neurology Pharmacist
- ;;NFPA^Non-Formulary/Prior Approval Pharmacist
- ;;NSPH^Nutritional Support Pharmacist
- ;;NUCL^Nuclear Medicine Pharmacist
- ;;ONCO^Oncology Pharmacist
- ;;OPTH^Ophthalmology Pharmacist
- ;;PACP^Patient Aligned Care Team Pharmacist
- ;;PACT^Patient Aligned Care Team
- ;;PGEN^Pharmacogenomics Pharmacist
- ;;PKPH^Pharmacokinetics Pharmacist
- ;;PTPH^Polytrauma Pharmacist
- ;;RHUM^Rheumatology Pharmacist
- ;;SPCH^Specialty Care Pharmacist
- ;;SUPH^Surgery/Anesthesia/OR Pharmacist
- ;;WMPH^Women's Health Pharmacist
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX133PT 2760 printed Apr 23, 2025@18:04:02 Page 2
- ECX133PT ;ALB/BP - PATCH ECX*3.0*133 Post-Init Rtn ; 11/24/09 2:11pm
- +1 ;;3.0;DSS EXTRACTS;**133**;Dec 22, 1997;Build 6
- +2 ;
- +3 ;Post-init routine to add new entries to:
- +4 ;
- +5 ; NATIONAL CLINIC file (#728.441)
- +6 ;
- +7 ;
- +8 QUIT
- EN ;Add new Clinic codes
- DO POST1
- +1 ;Change short description of existing clinic code
- DO POST2
- +2 QUIT
- +3 ;
- +4 ;
- 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
- +2 SET ECXCODE="CGRP"
- SET ECXDESC="Caregiver Support Program"
- +3 SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
- +4 SET DIE="^ECX(728.441,"
- SET DA=ECXIEN
- SET DR="1///^S X=ECXDESC"
- +5 DO ^DIE
- +6 ;
- NATCLIN ;- Contains the NATIONAL CLINIC entry to be added
- +1 ;;CCPH^Critical Care Pharmacist
- +2 ;;CDED^Cardiac Disease Education (CHF, etc)
- +3 ;;CRRC^Cardiovascular Risk Reduction Pharmacist
- +4 ;;DRPH^Dermatology Pharmacist
- +5 ;;EDPH^Emergency Department Pharmacist
- +6 ;;ESPH^ESA Pharmacist
- +7 ;;HEPC^Hepatitis C Pharmacist
- +8 ;;HIVD^HIV Pharmacist
- +9 ;;IMPH^Internal Medicine Pharmacist
- +10 ;;MREC^Medication Reconciliation Pharmacist
- +11 ;;MTMP^Medication Therapy Management Pharmacist
- +12 ;;NEUR^Neurology Pharmacist
- +13 ;;NFPA^Non-Formulary/Prior Approval Pharmacist
- +14 ;;NSPH^Nutritional Support Pharmacist
- +15 ;;NUCL^Nuclear Medicine Pharmacist
- +16 ;;ONCO^Oncology Pharmacist
- +17 ;;OPTH^Ophthalmology Pharmacist
- +18 ;;PACP^Patient Aligned Care Team Pharmacist
- +19 ;;PACT^Patient Aligned Care Team
- +20 ;;PGEN^Pharmacogenomics Pharmacist
- +21 ;;PKPH^Pharmacokinetics Pharmacist
- +22 ;;PTPH^Polytrauma Pharmacist
- +23 ;;RHUM^Rheumatology Pharmacist
- +24 ;;SPCH^Specialty Care Pharmacist
- +25 ;;SUPH^Surgery/Anesthesia/OR Pharmacist
- +26 ;;WMPH^Women's Health Pharmacist
- +27 ;;QUIT
