TIUPR230.m

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 ---TIUPR230   1890     printed  Mar 13, 2025@21:48:25                                                                                                                                                                                                    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