Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUPS148

TIUPS148.m

Go to the documentation of this file.
  1. TIUPS148 ; SLC/CAM-Creates PATIENT ETHNICITY TIU Object;10/31/02
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**148**;JUN 20,1997
  1. ;
  1. ; This patch was created to define the PATIENT ETHNICITY TIU data object
  1. ; in the TIU DOCUMENT DEFINITION file (8925.1).
  1. ; Once the PATIENT ETHNICITY object is created and functioning this
  1. ; routine can be deleted.
  1. ; If a TIU object named PATIENT ETHNICITY already exists on the system
  1. ; in which this routine is being installed the Object Method field (9)
  1. ; of the TIU DOCUMENT DEFINITION file (8925.1) will be overridden with
  1. ; the National Object Method for PATIENT ETHNICITY.
  1. ;
  1. N TIUDA,TIUOBNM
  1. S TIUDA=0,TIUOBNM="PATIENT ETHNICITY"
  1. S TIUDA=$$FIND1^DIC(8925.1,"","AMX",TIUOBNM,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
  1. I TIUDA'=0 D OBCHG Q
  1. I TIUDA=0 D CREATE Q
  1. ;
  1. CREATE ; Creates the PATIENT ETHNICITY TIU Object
  1. ;
  1. N FDA,FDAIEN,MSG
  1. S FDA(8925.1,"+1,",.01)=TIUOBNM
  1. S FDA(8925.1,"+1,",.03)=TIUOBNM
  1. S FDA(8925.1,"+1,",.04)="O"
  1. S FDA(8925.1,"+1,",.05)=DUZ
  1. S FDA(8925.1,"+1,",.07)="11"
  1. S FDA(8925.1,"+1,",9)="S X=$$ETHNIC^TIULO(DFN)"
  1. S FDA(8925.1,"+1,",99)=$H
  1. ;
  1. D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1. ;
  1. I $D(MSG) D Q
  1. . W !!,"TIU Object failed. The following error message was returned:",!!
  1. . S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
  1. ;
  1. W !!,"TIU Object created successfully"
  1. ;
  1. Q
  1. OBCHG ; Changes existing PATIENT ETHNICITY Object
  1. N DA,DIE,DR,X,TIUVAR
  1. ; Change Object Method
  1. S TIUVAR="S X=$$ETHNIC^TIULO(DFN)",DIE="^TIU(8925.1,",DR="9///^S X=TIUVAR",DA=TIUDA
  1. D ^DIE
  1. ;
  1. Q