ECX139PT ;ALB/AG-PATCH ECX*3.0*139 POST-INIT RTN; 4/20/12 10:52am ; 5/10/12 10:24am
;;3.0;DSS EXTRACTS;**139**;DEC 22, 1997;Build 6
;
;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
D BMES^XPDUTL(">>>Adding entry to the NATIONAL CLINIC (728.441) file...")
;
;-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")
.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
;;NILC^NonInstitutional LTC
;;PCCP^PHARMACY CALL CTR PHARMACIST
;;REIK^REIKI ALTERNATIVE THERAPY
;;VGCH^CVT GRP CHAPLAIN
;;VGCP^CVT GRP CLINICAL PHARMACIST
;;VGMD^CVT GRP PHYSICIAN
;;VGNP^CVT GRP NURS PRACT
;;VGOT^CVT GRP OCCUP THER
;;VGPO^CVT GRP PSYCHOLOGIST
;;VGPT^CVT GRP PHYS THER
;;VGRD^CVT GRP REGISTERED DIETICIAN
;;VGRN^CVT GRP REG NURS
;;VGRT^CVT GRP REC THER
;;VGSW^CVT GRP SOC WRK
;;QUIT
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
;;CGRC^Homeless CRRCs
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX139PT 2602 printed Nov 22, 2024@16:59:47 Page 2
ECX139PT ;ALB/AG-PATCH ECX*3.0*139 POST-INIT RTN; 4/20/12 10:52am ; 5/10/12 10:24am
+1 ;;3.0;DSS EXTRACTS;**139**;DEC 22, 1997;Build 6
+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 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(ADDCLIN+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 BMES^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
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 SET DIE="^ECX(728.441,"
SET DA=ECXIEN
SET DR="1///^S X=ECXDESC"
+7 DO ^DIE
+8 DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" updated")
End DoDot:1
+9 ;
ADDCLIN ;Contains the NATIONAL CLINIC entries to be added
+1 ;;NILC^NonInstitutional LTC
+2 ;;PCCP^PHARMACY CALL CTR PHARMACIST
+3 ;;REIK^REIKI ALTERNATIVE THERAPY
+4 ;;VGCH^CVT GRP CHAPLAIN
+5 ;;VGCP^CVT GRP CLINICAL PHARMACIST
+6 ;;VGMD^CVT GRP PHYSICIAN
+7 ;;VGNP^CVT GRP NURS PRACT
+8 ;;VGOT^CVT GRP OCCUP THER
+9 ;;VGPO^CVT GRP PSYCHOLOGIST
+10 ;;VGPT^CVT GRP PHYS THER
+11 ;;VGRD^CVT GRP REGISTERED DIETICIAN
+12 ;;VGRN^CVT GRP REG NURS
+13 ;;VGRT^CVT GRP REC THER
+14 ;;VGSW^CVT GRP SOC WRK
+15 ;;QUIT
UPDCLIN ;Contains the NATIONAL CLINIC entry description to be updated
+1 ;;CGRC^Homeless CRRCs
+2 ;;QUIT
