- ECX141PT ;ALB/AG-PATCH ECX*3.0*141 POST-INIT RTN; ; 10/5/12 10:46am
- ;;3.0;DSS EXTRACTS;**141**;DEC 22,1997;Build 5
- ;
- ;Post-init routine adding new entries and updating current entries to:
- ;
- ;NATIONAL CLINIC file(#728.441)
- ;
- ;
- Q
- EN ;Routine Entry Point
- D ADDNEW ;Add new Clinic codes
- D UPDATE ;Change short description of existing clinic codes
- Q
- ;
- ;
- ADDNEW ;Add new entry to file 728.441
- ;ECXREC is in format:code^short description
- ;
- ;
- N ECXFDA,ECXERR,ECXCODE,ECXREC,I
- ;
- ;-Get NATIONAL CLINIC record
- F I=1:1 S ECXREC=$P($T(ADDCLIN+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 BMES^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
- UPDATE ;Changing short description of existing clinic
- N ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,I
- D BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file...")
- F I=1:1 S ECXREC=$P($T(UPDCLIN+I),";;",2) Q:ECXREC="QUIT" D
- .S ECXCODE=$P(ECXREC,"^"),ECXDESC=$P(ECXREC,"^",2)
- .S ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
- .I ECXIEN="" D Q
- ..D BMES^XPDUTL(">>>...Unable to add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
- ..D BMES^XPDUTL("Contact support for assistance")
- .S DIE="^ECX(728.441,",DA=ECXIEN,DR="1///^S X=ECXDESC"
- .D ^DIE
- .D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" updated")
- ;
- ADDCLIN ;Contains the NATIONAL CLINIC entries to be added
- ;;EQTH^Equine Therapy
- ;;NCCH^Nat'lCallCtrforHomelessVets
- ;;QUIT
- UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
- ;;PLTR^Polytrauma PRC
- ;;PLTV^TBI CVT Telehealth Eval
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX141PT 2335 printed Jan 18, 2025@02:50:52 Page 2
- ECX141PT ;ALB/AG-PATCH ECX*3.0*141 POST-INIT RTN; ; 10/5/12 10:46am
- +1 ;;3.0;DSS EXTRACTS;**141**;DEC 22,1997;Build 5
- +2 ;
- +3 ;Post-init routine adding new entries and updating current entries to:
- +4 ;
- +5 ;NATIONAL CLINIC file(#728.441)
- +6 ;
- +7 ;
- +8 QUIT
- EN ;Routine Entry Point
- +1 ;Add new Clinic codes
- DO ADDNEW
- +2 ;Change short description of existing clinic codes
- DO UPDATE
- +3 QUIT
- +4 ;
- +5 ;
- ADDNEW ;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 ;
- +6 ;-Get NATIONAL CLINIC record
- +7 FOR I=1:1
- SET ECXREC=$PIECE($TEXT(ADDCLIN+I),";;",2)
- if ECXREC="QUIT"
- QUIT
- Begin DoDot:1
- +8 ;
- +9 ;-National Clinic code
- +10 SET ECXCODE=$PIECE(ECXREC,"^")
- +11 ;
- +12 ;-Quit w/error message if entry already exists in file #728.441
- +13 IF $$FIND1^DIC(728.441,"","X",ECXCODE)
- Begin DoDot:2
- +14 DO BMES^XPDUTL(">>>..."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" not added, entry already exists.")
- +15 DO BMES^XPDUTL(">>> Delete entries and reinstall patch if entries were not created by a")
- +16 DO BMES^XPDUTL(">>> previous installation of this patch.")
- End DoDot:2
- QUIT
- +17 ;
- +18 ;-Setup field values of new entry
- +19 SET ECXFDA(728.441,"+1,",.01)=ECXCODE
- +20 SET ECXFDA(728.441,"+1,",1)=$PIECE(ECXREC,"^",2)
- +21 ;
- +22 ;-Add new entry to file #728.441
- +23 DO UPDATE^DIE("E","ECXFDA","","ECXERR")
- +24 ;
- +25 IF '$DATA(ECXERR)
- DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" added to file.")
- +26 IF $DATA(ECXERR)
- DO BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$PIECE(ECXREC,U,2)_"to file.")
- End DoDot:1
- +27 ;
- +28 QUIT
- UPDATE ;Changing short description of existing clinic
- +1 NEW ECXCODE,ECXDESC,ECXIEN,DIE,DA,DR,I
- +2 DO BMES^XPDUTL(">>>Updating entry in the NATIONAL CLINIC (728.441) file...")
- +3 FOR I=1:1
- SET ECXREC=$PIECE($TEXT(UPDCLIN+I),";;",2)
- if ECXREC="QUIT"
- QUIT
- Begin DoDot:1
- +4 SET ECXCODE=$PIECE(ECXREC,"^")
- SET ECXDESC=$PIECE(ECXREC,"^",2)
- +5 SET ECXIEN=$$FIND1^DIC(728.441,"","X",ECXCODE,"","","ERR")
- +6 IF ECXIEN=""
- Begin DoDot:2
- +7 DO BMES^XPDUTL(">>>...Unable to add "_ECXCODE_" "_$PIECE(ECXREC,U,2)_" to file.")
- +8 DO BMES^XPDUTL("Contact support for assistance")
- End DoDot:2
- QUIT
- +9 SET DIE="^ECX(728.441,"
- SET DA=ECXIEN
- SET DR="1///^S X=ECXDESC"
- +10 DO ^DIE
- +11 DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" updated")
- End DoDot:1
- +12 ;
- ADDCLIN ;Contains the NATIONAL CLINIC entries to be added
- +1 ;;EQTH^Equine Therapy
- +2 ;;NCCH^Nat'lCallCtrforHomelessVets
- +3 ;;QUIT
- UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
- +1 ;;PLTR^Polytrauma PRC
- +2 ;;PLTV^TBI CVT Telehealth Eval
- +3 ;;QUIT