TIUPS130 ; SLC/JER - Post-Install for TIU*1*130 ;18-JUN-2002 13:59:42
;;1.0;Text Integration Utilities;**130**;Jun 20, 1997
MAIN ; Control subroutine
N TIUDA,LUVALUE,TIUFPRIV,TEXT,TIUCWDC
S TIUFPRIV=1
S TEXT=" Installing Document Definitions for RISK OF CJD..."
D BMES^XPDUTL(TEXT)
; Attach the new RISK OF CJD Title to CLINICAL WARNINGS
S TIUDA=+$$DOCDEF("RISK OF CJ","DOC")
I 'TIUDA D Q
. D BMES^XPDUTL(" Unable to locate Title RISK OF CJD...")
S TIUCWDC=$$DOCDEF("CLINICAL WARNIN","DC")
I 'TIUCWDC D Q
. D BMES^XPDUTL(" Unable to locate Document Class CLINICAL WARNINGS...")
D ADDITEM(TIUDA,TIUCWDC)
Q
DOCDEF(TIUDNM,TYPE) ; Find the Document Definition
N TIUY,POP,TIUODNM S (POP,TIUY)=0,TYPE=$G(TYPE,"DOC"),TIUODNM=TIUDNM
F S TIUDNM=$O(^TIU(8925.1,"B",TIUDNM)) Q:POP!(TIUDNM'[TIUODNM) D
. S TIUY=0
. F S TIUY=$O(^TIU(8925.1,"B",TIUDNM,TIUY)) Q:+TIUY'>0 D Q:POP
. . I $P($G(^TIU(8925.1,+TIUY,0)),U,4)=TYPE S POP=1
Q TIUY
ADDITEM(TIUDA,TIUCWDC) ; Add RISK OF CJD to Document Class CLINICAL WARNING
N DA,DIC,DLAYGO,DIE,DR,TIUI,TIUFPRIV,X,Y S TIUFPRIV=1
; Quit if CJD already an item in Clinical Warning DC
I +$O(^TIU(8925.1,TIUCWDC,10,"B",TIUDA,0)) D Q
. D BMES^XPDUTL(" Risk of CJD is Already Present as a Clinical Warning.")
S DIC="^TIU(8925.1,"_TIUCWDC_",10,",DLAYGO=8925.14,DIC(0)="LNX"
S X=""""_"`"_TIUDA_"""",DA(1)=TIUCWDC
D ^DIC Q:+Y'>0
S TIUI=$P(^TIU(8925.1,TIUCWDC,10,0),U,4)
S DA(1)=TIUCWDC,DA=+Y,DIE=DIC
S DR="2////^S X=TIUI;3////^S X=TIUI;4////Risk of CJD"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS130 1557 printed Nov 22, 2024@17:53:56 Page 2
TIUPS130 ; SLC/JER - Post-Install for TIU*1*130 ;18-JUN-2002 13:59:42
+1 ;;1.0;Text Integration Utilities;**130**;Jun 20, 1997
MAIN ; Control subroutine
+1 NEW TIUDA,LUVALUE,TIUFPRIV,TEXT,TIUCWDC
+2 SET TIUFPRIV=1
+3 SET TEXT=" Installing Document Definitions for RISK OF CJD..."
+4 DO BMES^XPDUTL(TEXT)
+5 ; Attach the new RISK OF CJD Title to CLINICAL WARNINGS
+6 SET TIUDA=+$$DOCDEF("RISK OF CJ","DOC")
+7 IF 'TIUDA
Begin DoDot:1
+8 DO BMES^XPDUTL(" Unable to locate Title RISK OF CJD...")
End DoDot:1
QUIT
+9 SET TIUCWDC=$$DOCDEF("CLINICAL WARNIN","DC")
+10 IF 'TIUCWDC
Begin DoDot:1
+11 DO BMES^XPDUTL(" Unable to locate Document Class CLINICAL WARNINGS...")
End DoDot:1
QUIT
+12 DO ADDITEM(TIUDA,TIUCWDC)
+13 QUIT
DOCDEF(TIUDNM,TYPE) ; Find the Document Definition
+1 NEW TIUY,POP,TIUODNM
SET (POP,TIUY)=0
SET TYPE=$GET(TYPE,"DOC")
SET TIUODNM=TIUDNM
+2 FOR
SET TIUDNM=$ORDER(^TIU(8925.1,"B",TIUDNM))
if POP!(TIUDNM'[TIUODNM)
QUIT
Begin DoDot:1
+3 SET TIUY=0
+4 FOR
SET TIUY=$ORDER(^TIU(8925.1,"B",TIUDNM,TIUY))
if +TIUY'>0
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)=TYPE
SET POP=1
End DoDot:2
if POP
QUIT
End DoDot:1
+6 QUIT TIUY
ADDITEM(TIUDA,TIUCWDC) ; Add RISK OF CJD to Document Class CLINICAL WARNING
+1 NEW DA,DIC,DLAYGO,DIE,DR,TIUI,TIUFPRIV,X,Y
SET TIUFPRIV=1
+2 ; Quit if CJD already an item in Clinical Warning DC
+3 IF +$ORDER(^TIU(8925.1,TIUCWDC,10,"B",TIUDA,0))
Begin DoDot:1
+4 DO BMES^XPDUTL(" Risk of CJD is Already Present as a Clinical Warning.")
End DoDot:1
QUIT
+5 SET DIC="^TIU(8925.1,"_TIUCWDC_",10,"
SET DLAYGO=8925.14
SET DIC(0)="LNX"
+6 SET X=""""_"`"_TIUDA_""""
SET DA(1)=TIUCWDC
+7 DO ^DIC
if +Y'>0
QUIT
+8 SET TIUI=$PIECE(^TIU(8925.1,TIUCWDC,10,0),U,4)
+9 SET DA(1)=TIUCWDC
SET DA=+Y
SET DIE=DIC
+10 SET DR="2////^S X=TIUI;3////^S X=TIUI;4////Risk of CJD"
+11 DO ^DIE
+12 QUIT
