TIUPS148.m

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 ---TIUPS148   1631     printed  Apr 09, 2024@21:47:41                                                                                                                                                                                                    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