1 | TIUPR230 ;SLC/AJB - Objects Skin Risk Assessment;10JUL07
|
---|
2 | ;;1.0;TEXT INTEGRATION UTILITIES;**230**;Jun 20, 1997;Build 18
|
---|
3 | Q
|
---|
4 | EN ; entry
|
---|
5 | N TIUFPRIV
|
---|
6 | I '$D(ZTQUEUED) X ^%ZOSF("EON") W $G(IOCUON),@IOF ; turn cursor on & clear display
|
---|
7 | S TIUFPRIV=1
|
---|
8 | D DELOBJS,MKOBJS ; remove and install TIU objects
|
---|
9 | W !!,"Object creation finished."
|
---|
10 | Q
|
---|
11 | DATA ; TIU object names & HS object names
|
---|
12 | ;;BRADEN SCALE 30D;VA-BRADEN SCALE 30D (TIU)
|
---|
13 | ;;PRESSURE ULCER;VA-PRESSURE ULCER (TIU)
|
---|
14 | ;;PU INTERVENTIONS;VA-PU INTERVENTIONS (TIU)
|
---|
15 | ;;EOM
|
---|
16 | Q
|
---|
17 | DELOBJS ; remove duplicate names prior to install
|
---|
18 | N DA,DIK,OBJNAME,TIUDAT,TIULN,X,Y
|
---|
19 | F TIUDAT=1:1 S TIULN=$P($T(DATA+TIUDAT),";;",2) Q:TIULN="EOM" D
|
---|
20 | .S OBJNAME=$P(TIULN,";")
|
---|
21 | .S DA=0,DA=$O(^TIU(8925.1,"B",OBJNAME,DA))
|
---|
22 | .S DIK="^TIU(8925.1,"
|
---|
23 | .I DA>0 D ^DIK
|
---|
24 | Q
|
---|
25 | LU(FILE,NAME) ; DBS lookup
|
---|
26 | Q $$FIND1^DIC(FILE,"",,NAME,,,"TIUERR")
|
---|
27 | MKOBJS ; make TIU objects
|
---|
28 | N HSNAME,METHOD,OBJNAME,TIUDAT,TIULN
|
---|
29 | F TIUDAT=1:1 S TIULN=$P($T(DATA+TIUDAT),";;",2) Q:TIULN="EOM" D
|
---|
30 | . S OBJNAME=$P(TIULN,";"),HSNAME=$P(TIULN,";",2)
|
---|
31 | . S METHOD="S X=$$TIU^GMTSOBJ(DFN,"_$$LU(142.5,HSNAME)_")"
|
---|
32 | . I $$MKOBJ(OBJNAME,METHOD)<0 D
|
---|
33 | . . W:'$D(ZTQUEUED) !!,"Installation Error: Creation of TIU Object "_NAME_" failed.",!
|
---|
34 | Q
|
---|
35 | MKOBJ(OBJNAME,METHOD) ; create TIU object
|
---|
36 | N FDA,FDAIEN,MSG
|
---|
37 | S FDA(8925.1,"+1,",.01)=OBJNAME
|
---|
38 | S FDA(8925.1,"+1,",.03)=OBJNAME
|
---|
39 | S FDA(8925.1,"+1,",.04)="O"
|
---|
40 | S FDA(8925.1,"+1,",.06)=$$LU(8930,"CLINICAL COORDINATOR")
|
---|
41 | S FDA(8925.1,"+1,",.07)=11
|
---|
42 | S FDA(8925.1,"+1,",9)=METHOD
|
---|
43 | S FDA(8925.1,"+1,",99)=$H
|
---|
44 | D UPDATE^DIE("","FDA","FDAIEN","MSG")
|
---|
45 | I $D(MSG),'$D(ZTQUEUED) D Q -1
|
---|
46 | . W !!,"TIU Object creation failed. The following error message was returned:",!!
|
---|
47 | . S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
|
---|
48 | W:'$D(ZTQUEUED) !!,"Creation of TIU Object "_OBJNAME_" successful..." H 1
|
---|
49 | Q 1
|
---|