TIUPS130.m

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

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