TIUPS148 ; SLC/CAM-Creates PATIENT ETHNICITY TIU Object;10/31/02
;;1.0;TEXT INTEGRATION UTILITIES;**148**;JUN 20,1997
;
; This patch was created to define the PATIENT ETHNICITY TIU data object
; in the TIU DOCUMENT DEFINITION file (8925.1).
; Once the PATIENT ETHNICITY object is created and functioning this
; routine can be deleted.
; If a TIU object named PATIENT ETHNICITY already exists on the system
; in which this routine is being installed the Object Method field (9)
; of the TIU DOCUMENT DEFINITION file (8925.1) will be overridden with
; the National Object Method for PATIENT ETHNICITY.
;
N TIUDA,TIUOBNM
S TIUDA=0,TIUOBNM="PATIENT ETHNICITY"
S TIUDA=$$FIND1^DIC(8925.1,"","AMX",TIUOBNM,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
I TIUDA'=0 D OBCHG Q
I TIUDA=0 D CREATE Q
;
CREATE ; Creates the PATIENT ETHNICITY TIU Object
;
N FDA,FDAIEN,MSG
S FDA(8925.1,"+1,",.01)=TIUOBNM
S FDA(8925.1,"+1,",.03)=TIUOBNM
S FDA(8925.1,"+1,",.04)="O"
S FDA(8925.1,"+1,",.05)=DUZ
S FDA(8925.1,"+1,",.07)="11"
S FDA(8925.1,"+1,",9)="S X=$$ETHNIC^TIULO(DFN)"
S FDA(8925.1,"+1,",99)=$H
;
D UPDATE^DIE("","FDA","FDAIEN","MSG")
;
I $D(MSG) D Q
. W !!,"TIU Object failed. The following error message was returned:",!!
. S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
;
W !!,"TIU Object created successfully"
;
Q
OBCHG ; Changes existing PATIENT ETHNICITY Object
N DA,DIE,DR,X,TIUVAR
; Change Object Method
S TIUVAR="S X=$$ETHNIC^TIULO(DFN)",DIE="^TIU(8925.1,",DR="9///^S X=TIUVAR",DA=TIUDA
D ^DIE
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS148 1631 printed Dec 13, 2024@02:44:04 Page 2
TIUPS148 ; SLC/CAM-Creates PATIENT ETHNICITY TIU Object;10/31/02
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**148**;JUN 20,1997
+2 ;
+3 ; This patch was created to define the PATIENT ETHNICITY TIU data object
+4 ; in the TIU DOCUMENT DEFINITION file (8925.1).
+5 ; Once the PATIENT ETHNICITY object is created and functioning this
+6 ; routine can be deleted.
+7 ; If a TIU object named PATIENT ETHNICITY already exists on the system
+8 ; in which this routine is being installed the Object Method field (9)
+9 ; of the TIU DOCUMENT DEFINITION file (8925.1) will be overridden with
+10 ; the National Object Method for PATIENT ETHNICITY.
+11 ;
+12 NEW TIUDA,TIUOBNM
+13 SET TIUDA=0
SET TIUOBNM="PATIENT ETHNICITY"
+14 SET TIUDA=$$FIND1^DIC(8925.1,"","AMX",TIUOBNM,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
+15 IF TIUDA'=0
DO OBCHG
QUIT
+16 IF TIUDA=0
DO CREATE
QUIT
+17 ;
CREATE ; Creates the PATIENT ETHNICITY TIU Object
+1 ;
+2 NEW FDA,FDAIEN,MSG
+3 SET FDA(8925.1,"+1,",.01)=TIUOBNM
+4 SET FDA(8925.1,"+1,",.03)=TIUOBNM
+5 SET FDA(8925.1,"+1,",.04)="O"
+6 SET FDA(8925.1,"+1,",.05)=DUZ
+7 SET FDA(8925.1,"+1,",.07)="11"
+8 SET FDA(8925.1,"+1,",9)="S X=$$ETHNIC^TIULO(DFN)"
+9 SET FDA(8925.1,"+1,",99)=$HOROLOG
+10 ;
+11 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+12 ;
+13 IF $DATA(MSG)
Begin DoDot:1
+14 WRITE !!,"TIU Object failed. The following error message was returned:",!!
+15 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:1
QUIT
+16 ;
+17 WRITE !!,"TIU Object created successfully"
+18 ;
+19 QUIT
OBCHG ; Changes existing PATIENT ETHNICITY Object
+1 NEW DA,DIE,DR,X,TIUVAR
+2 ; Change Object Method
+3 SET TIUVAR="S X=$$ETHNIC^TIULO(DFN)"
SET DIE="^TIU(8925.1,"
SET DR="9///^S X=TIUVAR"
SET DA=TIUDA
+4 DO ^DIE
+5 ;
+6 QUIT
