TIUPR230 ;SLC/AJB - Objects Skin Risk Assessment;10JUL07
;;1.0;TEXT INTEGRATION UTILITIES;**230**;Jun 20, 1997;Build 18
Q
EN ; entry
N TIUFPRIV
I '$D(ZTQUEUED) X ^%ZOSF("EON") W $G(IOCUON),@IOF ; turn cursor on & clear display
S TIUFPRIV=1
D DELOBJS,MKOBJS ; remove and install TIU objects
W !!,"Object creation finished."
Q
DATA ; TIU object names & HS object names
;;BRADEN SCALE 30D;VA-BRADEN SCALE 30D (TIU)
;;PRESSURE ULCER;VA-PRESSURE ULCER (TIU)
;;PU INTERVENTIONS;VA-PU INTERVENTIONS (TIU)
;;EOM
Q
DELOBJS ; remove duplicate names prior to install
N DA,DIK,OBJNAME,TIUDAT,TIULN,X,Y
F TIUDAT=1:1 S TIULN=$P($T(DATA+TIUDAT),";;",2) Q:TIULN="EOM" D
.S OBJNAME=$P(TIULN,";")
.S DA=0,DA=$O(^TIU(8925.1,"B",OBJNAME,DA))
.S DIK="^TIU(8925.1,"
.I DA>0 D ^DIK
Q
LU(FILE,NAME) ; DBS lookup
Q $$FIND1^DIC(FILE,"",,NAME,,,"TIUERR")
MKOBJS ; make TIU objects
N HSNAME,METHOD,OBJNAME,TIUDAT,TIULN
F TIUDAT=1:1 S TIULN=$P($T(DATA+TIUDAT),";;",2) Q:TIULN="EOM" D
. S OBJNAME=$P(TIULN,";"),HSNAME=$P(TIULN,";",2)
. S METHOD="S X=$$TIU^GMTSOBJ(DFN,"_$$LU(142.5,HSNAME)_")"
. I $$MKOBJ(OBJNAME,METHOD)<0 D
. . W:'$D(ZTQUEUED) !!,"Installation Error: Creation of TIU Object "_NAME_" failed.",!
Q
MKOBJ(OBJNAME,METHOD) ; create TIU object
N FDA,FDAIEN,MSG
S FDA(8925.1,"+1,",.01)=OBJNAME
S FDA(8925.1,"+1,",.03)=OBJNAME
S FDA(8925.1,"+1,",.04)="O"
S FDA(8925.1,"+1,",.06)=$$LU(8930,"CLINICAL COORDINATOR")
S FDA(8925.1,"+1,",.07)=11
S FDA(8925.1,"+1,",9)=METHOD
S FDA(8925.1,"+1,",99)=$H
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG),'$D(ZTQUEUED) D Q -1
. W !!,"TIU Object creation 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:'$D(ZTQUEUED) !!,"Creation of TIU Object "_OBJNAME_" successful..." H 1
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPR230 1890 printed Apr 09, 2024@21:47:50 Page 2
TIUPR230 ;SLC/AJB - Objects Skin Risk Assessment;10JUL07
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**230**;Jun 20, 1997;Build 18
+2 QUIT
EN ; entry
+1 NEW TIUFPRIV
+2 ; turn cursor on & clear display
IF '$DATA(ZTQUEUED)
XECUTE ^%ZOSF("EON")
WRITE $GET(IOCUON),@IOF
+3 SET TIUFPRIV=1
+4 ; remove and install TIU objects
DO DELOBJS
DO MKOBJS
+5 WRITE !!,"Object creation finished."
+6 QUIT
DATA ; TIU object names & HS object names
+1 ;;BRADEN SCALE 30D;VA-BRADEN SCALE 30D (TIU)
+2 ;;PRESSURE ULCER;VA-PRESSURE ULCER (TIU)
+3 ;;PU INTERVENTIONS;VA-PU INTERVENTIONS (TIU)
+4 ;;EOM
+5 QUIT
DELOBJS ; remove duplicate names prior to install
+1 NEW DA,DIK,OBJNAME,TIUDAT,TIULN,X,Y
+2 FOR TIUDAT=1:1
SET TIULN=$PIECE($TEXT(DATA+TIUDAT),";;",2)
if TIULN="EOM"
QUIT
Begin DoDot:1
+3 SET OBJNAME=$PIECE(TIULN,";")
+4 SET DA=0
SET DA=$ORDER(^TIU(8925.1,"B",OBJNAME,DA))
+5 SET DIK="^TIU(8925.1,"
+6 IF DA>0
DO ^DIK
End DoDot:1
+7 QUIT
LU(FILE,NAME) ; DBS lookup
+1 QUIT $$FIND1^DIC(FILE,"",,NAME,,,"TIUERR")
MKOBJS ; make TIU objects
+1 NEW HSNAME,METHOD,OBJNAME,TIUDAT,TIULN
+2 FOR TIUDAT=1:1
SET TIULN=$PIECE($TEXT(DATA+TIUDAT),";;",2)
if TIULN="EOM"
QUIT
Begin DoDot:1
+3 SET OBJNAME=$PIECE(TIULN,";")
SET HSNAME=$PIECE(TIULN,";",2)
+4 SET METHOD="S X=$$TIU^GMTSOBJ(DFN,"_$$LU(142.5,HSNAME)_")"
+5 IF $$MKOBJ(OBJNAME,METHOD)<0
Begin DoDot:2
+6 if '$DATA(ZTQUEUED)
WRITE !!,"Installation Error: Creation of TIU Object "_NAME_" failed.",!
End DoDot:2
End DoDot:1
+7 QUIT
MKOBJ(OBJNAME,METHOD) ; create TIU object
+1 NEW FDA,FDAIEN,MSG
+2 SET FDA(8925.1,"+1,",.01)=OBJNAME
+3 SET FDA(8925.1,"+1,",.03)=OBJNAME
+4 SET FDA(8925.1,"+1,",.04)="O"
+5 SET FDA(8925.1,"+1,",.06)=$$LU(8930,"CLINICAL COORDINATOR")
+6 SET FDA(8925.1,"+1,",.07)=11
+7 SET FDA(8925.1,"+1,",9)=METHOD
+8 SET FDA(8925.1,"+1,",99)=$HOROLOG
+9 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+10 IF $DATA(MSG)
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+11 WRITE !!,"TIU Object creation failed. The following error message was returned:",!!
+12 SET MSG=""
FOR
SET MSG=$ORDER(MSG("DIERR",1,"TEXT",MSG))
if MSG=""
QUIT
WRITE MSG("DIERR",1,"TEXT",MSG),!
End DoDot:1
QUIT -1
+13 if '$DATA(ZTQUEUED)
WRITE !!,"Creation of TIU Object "_OBJNAME_" successful..."
HANG 1
+14 QUIT 1
