- 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 Feb 19, 2025@00:10:33 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