TIUFT ; SLC/MAM - LM Template T (Items) INIT, Action Add Items ; 4-AUG-1999 10:52:47
;;1.0;TEXT INTEGRATION UTILITIES;**2,5,17,27,77**;Jun 20, 1997
HDR ; -- header code
; Requires Array TIUFNOD0.
N TYPE,NAME
S NAME=$P(TIUFNOD0,U)
I $L(NAME)>60 S TYPE=$P(TIUFNOD0,U,4) S:TYPE="DOC" TYPE="TL" G SETHDR
S TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
SETHDR I TYPE'="" S TYPE=TYPE_" "
S VALMHDR(1)=$$CENTER^TIUFL("Items for "_TYPE_NAME,79)
HDRX Q
;
INIT ; -- init variables and list array; Also Update.
; Requires TIUFSTMP as set in EDITEMS^TIUFD2.
; Requires CURRENT array TIUFINFO
;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
;in AUPDATE^TIUFLA1.
;WARNING: +TIUFINFO may = 0!
N LINENO,FILEDA
K ^TMP("TIUF2",$J),^TMP("TIUF2IDX",$J)
D CLEAN^VALM10
S FILEDA=TIUFINFO("FILEDA"),VALMCNT=0
I '$O(^TIU(8925.1,FILEDA,10,0)) D G INITX
. S ^TMP("TIUF2",$J,1,0)=""
. S ^TMP("TIUF2",$J,2,0)="Entry has no items.",VALMCNT=2
. Q
S LINENO=0
; EDit Items checks item existence, so we know items exist in file:
D BUFITEMS^TIUFLT("T",.TIUFINFO,.LINENO) G:$D(DTOUT) INITX
D UPDATE^TIUFLLM1("T",LINENO,0) S VALMCNT=VALMCNT+LINENO
INITX I $D(DTOUT) S VALMQUIT=1
Q
;
EXIT ; -- exit code for LM Template T
K ^TMP("TIUF2",$J),^TMP("TIUFB",$J),^TMP("TIUF2IDX",$J),^TMP("TIUFBIDX",$J)
Q
;
ADD ; Template T (Items) Action Add Items
; Adds new or existing Docmt Defs to parent entry as items.
; Updates Template H or A and D as well as Item Template I.
; Requires CURRENT arrays TIUFINFO, TIUFNOD0, CURRENT variable TUIFVCN1
;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
;in AUPDATE^TIUFLA1, or (if Template H has changed) in UPDATE^TIUFLLM1.
;WARNING: +TIUFINFO may = 0 if Template A has changed!
; Requires TIUFTMPL, TIUFSTMP.
; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
; If TIUFTMPL ="A", Requires TIUFATTR, TIUFAVAL as set in protocols TIUF SORT BY...
N FILEDA,NEWOR,ADDFLAG,DIC,DLAYGO,X,Y,NFILEDA,NEWFLAG,NEWSTAT
N MSG2,MSG,MSG1,TENDA,DA,DIE,DR,CFILEDA,LINENO,DTOUT,DIRUT,DIROUT,DUOUT
N CNTCHNG,FIELDS,DIK,TIUFOUT1,EXITFLG,TIUFXNOD,TIUFY,TIUFXHLX
N NNODE0,TIUFTMSG,TIUFTLST,TIUFIMSG,SEQUENCE,SUBS,OVERRIDE,DDEFUSED
S FILEDA=TIUFINFO("FILEDA"),TIUFXNOD=$G(XQORNOD(0))
S VALMBCK=""
I TIUFWHO="N" D FULL^VALM1,OVERWARN^TIUFHA2
I $P(TIUFNOD0,U,13),TIUFWHO'="N",$P(TIUFNOD0,U,4)="DOC"!($P(TIUFNOD0,U,4)="CO") W !!," Parent is National, of Type TL or CO; Can't add or delete Items" D PAUSE^TIUFXHLX G ADDX
S (ADDFLAG,TIUFOUT1)=0
; Can't avoid redisplay since may have asked for help or answered no, not adding, in which case must erase and redisplay.
F D L -^TIU(8925.1,+$G(NFILEDA)) G:$D(DTOUT) ADDX S VALMSG=$$VMSG^TIUFL D RE^VALM4,RESET^TIUFXHLX S:$D(DUOUT) TIUFOUT1=1 Q:TIUFOUT1
. K MSG2
. D FULL^VALM1 ;displays list before does XE Help, so must full here
. S DIC("A")=$S(TIUFWHO="C":"Enter Shared Component Name to add as Item: ",1:"Enter Document Definition Name to add as Item: ")
. S DIC=8925.1,DIC(0)="AELQ" I TIUFWHO="C" S DIC(0)="AEQ"
. S DIC("S")=$S(TIUFWHO="C":"I $P(^(0),U,10)&($P(^(0),U,4)=""CO"")",1:$$NAMSCRN^TIUFLF2(FILEDA)),DLAYGO=8925.1
. N OVERRIDE S OVERRIDE=$$OVERRIDE^TIUFHA2("be allowed to select ANY inactive orphan item, including the wrong TYPE") Q:$D(DIRUT) I TIUFWHO="N",'OVERRIDE W !," OK, you can only select appropriate items:",!
. I OVERRIDE S DIC("S")="I $$ORPHAN^TIUFLF4(Y,^TIU(8925.1,Y,0))=""YES"""
. D ^DIC S TIUFY=Y
. I TIUFY=-1 S TIUFOUT1=1 Q
. S NFILEDA=+TIUFY,NEWFLAG=$P(TIUFY,U,3),NNODE0=^TIU(8925.1,NFILEDA,0)
. L +^TIU(8925.1,NFILEDA):1 I '$T W !!,"Another user is editing item. Please try later.",! K DUOUT D PAUSE^TIUFXHLX Q
. I 'NEWFLAG,$$STATWORD^TIUFLF5($P(^TIU(8925.1,+Y,0),U,7))'="INACTIVE" W !!,"NOT inactive; Can't add Item",! H 3 Q
. S DDEFUSED=$$DDEFUSED^TIUFLF(NFILEDA)
. I TIUFWHO'="N",DDEFUSED="YES" N DIR,Y D Q:'Y
. . I $P(NNODE0,U,10) S Y=1 Q ;P76 Shared component
. . I $P(NNODE0,U,4)'="DOC" S Y=0 Q
. . S DIR(0)="Y",DIR("B")="NO"
. . S DIR("A",1)="WARNING: This orphan Title is already IN USE, an ABNORMAL situation. You will",DIR("A",2)="have to take additional actions after adding it. You will not be able to",DIR("A",3)="delete it once it is added."
. . S DIR("A")=" Want to go ahead and add it anyway" W ! D ^DIR
. N TIUFIMSG I $$DUP^TIUFLF7($P(NNODE0,U),FILEDA,NFILEDA) W !!,TIUFIMSG,! K DUOUT D PAUSE^TIUFXHLX D:NEWFLAG DELETE(NFILEDA) Q
. D TYPELIST^TIUFLF7($P(NNODE0,U),NFILEDA,FILEDA,.TIUFTMSG,.TIUFTLST) I $D(DTOUT) D:NEWFLAG DELETE(NFILEDA) Q
. I $D(TIUFTMSG("T")) W !!,TIUFTMSG("T"),!,"Can't add Item",! K DUOUT D PAUSE^TIUFXHLX D:NEWFLAG DELETE(NFILEDA) Q ;Parent has no/wrong type
. I TIUFTLST="" W !!," Please enter a different Name; File already has entries of every permitted Type",!,"with that Name",! K DUOUT D PAUSE^TIUFXHLX D:NEWFLAG DELETE(NFILEDA) Q
. I NEWFLAG D STUFFLDS^TIUFLF4(NFILEDA,FILEDA) S NNODE0=^TIU(8925.1,NFILEDA,0)
. W !!," Editing prospective Item:",!
. S EXITFLG=0
. I NEWFLAG S FIELDS=";.05;.06;" S:$P(NNODE0,U,4)="" FIELDS=";.04"_FIELDS S:TIUFWHO="N" FIELDS=FIELDS_".13;" D ASKFLDS^TIUFLF1(NFILEDA,FIELDS,FILEDA,.NEWSTAT,.EXITFLG) Q:$D(DTOUT)
. D OWNCHEC^TIUFLF8(NFILEDA)
. N TIUFCK
. I 'OVERRIDE D CHECK^TIUFLF3(NFILEDA,FILEDA,1,.TIUFCK) D I $D(MSG2) S MSG=MSG1_MSG2 W !!,MSG,! K DUOUT D PAUSE^TIUFXHLX D:NEWFLAG DELETE(NFILEDA) Q
. . F SUBS="S","OBJ","OBJINACT","B","O","V","E","R","H","N","G","D" K TIUFCK(SUBS)
. . S MSG1="Can't Add Item: "
. . I $D(TIUFCK)>9 S MSG2=$P(TIUFCK,U,2) Q
. . S NNODE0=^TIU(8925.1,NFILEDA,0)
. . I $O(^TIU(8925.1,"AD",NFILEDA,0)),'$P(NNODE0,U,10) S MSG2="Item Already has Parent" Q
. . I $D(^TIU(8925.1,FILEDA,10,"B",NFILEDA)) S MSG2="Entry Already has Item"
. D ADDTEN^TIUFLF4(FILEDA,NFILEDA,NNODE0,.TENDA)
. I TENDA="" W " ?? Couldn't be added! " K DUOUT D PAUSE^TIUFXHLX Q
. I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1 ; Adding item affects parentage globally.
. I DDEFUSED'="YES",'EXITFLG,'$D(DTOUT) S FIELDS=";.07;" D ASKFLDS^TIUFLF1(NFILEDA,FIELDS,FILEDA,.NEWSTAT,.EXITFLG) Q:$D(DTOUT)
. S DA(1)=FILEDA,DA=TENDA
. I 'EXITFLG,'$D(DTOUT) D L -^TIU(8925.1,FILEDA,10,TENDA) Q:$D(DTOUT)
. . L +^TIU(8925.1,FILEDA,10,TENDA):1 I '$T W !!,"Another user is editing item. Please edit later.",! H 2 Q
. . S DIE="^TIU(8925.1,DA(1),10,"
. . S DR="3" D ^DIE I $D(Y)!$D(DTOUT) Q
. . I $P(TIUFNOD0,U,4)="CL" S SEQUENCE=$P(^TIU(8925.1,DA(1),10,DA,0),U,3),DR="2///^S X=SEQUENCE" I $L(SEQUENCE)<5,$L(SEQUENCE) D ^DIE ;Stuff mnem with seq value
. . S DR=$S($P(TIUFNOD0,U,4)="CL":"2;4",1:4) D ^DIE K DUOUT
. S MSG=" Item Added" W !,MSG,! H 1
. I DDEFUSED="YES" D D PAUSE^TIUFXHLX
. . I $P(NNODE0,U,10) Q ;P76
. . I TIUFWHO'="N" W !,"WARNING: You have just added a Title which is already IN USE. Please Update",!,"Parent Document Type for this Title. If documents still seem to be missing,",!,"please contact Customer Service.",! Q
. . W !,"WARNING: You have just added an item which is already IN USE. Please Update",!,"Parent Document Type for this Title/all Titles under this item. If documents"
. . W !,"are still missing, use TLDOCMTS^TIUFHA8 to reindex class cross references.",!
. ; Update Template T with Item:
. D INIT Q:$D(DTOUT)
. S LINENO=$O(^TMP("TIUF2IDX",$J,"DAF",NFILEDA,""))
. I LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1)) S VALMBG=LINENO
. S ADDFLAG=1
. ; Update Template A with item (may be new, may be no longer Orphan):
. I TIUFTMPL="A" D
. . D AUPDATE^TIUFLA1(NNODE0,NFILEDA,.CNTCHNG) S:CNTCHNG TIUFVCN1=TIUFVCN1+1 ;CNTCHNG is Count Change
G:'ADDFLAG ADDX
D NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0) G:$D(DTOUT) ADDX
; Template D is updated when return to it from T
; Template H doesn't need update: will just reexpand when leave items.
ADDX ;
I $D(DTOUT) S VALMBCK="Q"
Q
;
DELETE(DA) ; Delete DA from file
N DIK S DIK="^TIU(8925.1," D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFT 8006 printed Nov 22, 2024@17:51:20 Page 2
TIUFT ; SLC/MAM - LM Template T (Items) INIT, Action Add Items ; 4-AUG-1999 10:52:47
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**2,5,17,27,77**;Jun 20, 1997
HDR ; -- header code
+1 ; Requires Array TIUFNOD0.
+2 NEW TYPE,NAME
+3 SET NAME=$PIECE(TIUFNOD0,U)
+4 IF $LENGTH(NAME)>60
SET TYPE=$PIECE(TIUFNOD0,U,4)
if TYPE="DOC"
SET TYPE="TL"
GOTO SETHDR
+5 SET TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
SETHDR IF TYPE'=""
SET TYPE=TYPE_" "
+1 SET VALMHDR(1)=$$CENTER^TIUFL("Items for "_TYPE_NAME,79)
HDRX QUIT
+1 ;
INIT ; -- init variables and list array; Also Update.
+1 ; Requires TIUFSTMP as set in EDITEMS^TIUFD2.
+2 ; Requires CURRENT array TIUFINFO
+3 ;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
+4 ;in AUPDATE^TIUFLA1.
+5 ;WARNING: +TIUFINFO may = 0!
+6 NEW LINENO,FILEDA
+7 KILL ^TMP("TIUF2",$JOB),^TMP("TIUF2IDX",$JOB)
+8 DO CLEAN^VALM10
+9 SET FILEDA=TIUFINFO("FILEDA")
SET VALMCNT=0
+10 IF '$ORDER(^TIU(8925.1,FILEDA,10,0))
Begin DoDot:1
+11 SET ^TMP("TIUF2",$JOB,1,0)=""
+12 SET ^TMP("TIUF2",$JOB,2,0)="Entry has no items."
SET VALMCNT=2
+13 QUIT
End DoDot:1
GOTO INITX
+14 SET LINENO=0
+15 ; EDit Items checks item existence, so we know items exist in file:
+16 DO BUFITEMS^TIUFLT("T",.TIUFINFO,.LINENO)
if $DATA(DTOUT)
GOTO INITX
+17 DO UPDATE^TIUFLLM1("T",LINENO,0)
SET VALMCNT=VALMCNT+LINENO
INITX IF $DATA(DTOUT)
SET VALMQUIT=1
+1 QUIT
+2 ;
EXIT ; -- exit code for LM Template T
+1 KILL ^TMP("TIUF2",$JOB),^TMP("TIUFB",$JOB),^TMP("TIUF2IDX",$JOB),^TMP("TIUFBIDX",$JOB)
+2 QUIT
+3 ;
ADD ; Template T (Items) Action Add Items
+1 ; Adds new or existing Docmt Defs to parent entry as items.
+2 ; Updates Template H or A and D as well as Item Template I.
+3 ; Requires CURRENT arrays TIUFINFO, TIUFNOD0, CURRENT variable TUIFVCN1
+4 ;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
+5 ;in AUPDATE^TIUFLA1, or (if Template H has changed) in UPDATE^TIUFLLM1.
+6 ;WARNING: +TIUFINFO may = 0 if Template A has changed!
+7 ; Requires TIUFTMPL, TIUFSTMP.
+8 ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
+9 ; If TIUFTMPL ="A", Requires TIUFATTR, TIUFAVAL as set in protocols TIUF SORT BY...
+10 NEW FILEDA,NEWOR,ADDFLAG,DIC,DLAYGO,X,Y,NFILEDA,NEWFLAG,NEWSTAT
+11 NEW MSG2,MSG,MSG1,TENDA,DA,DIE,DR,CFILEDA,LINENO,DTOUT,DIRUT,DIROUT,DUOUT
+12 NEW CNTCHNG,FIELDS,DIK,TIUFOUT1,EXITFLG,TIUFXNOD,TIUFY,TIUFXHLX
+13 NEW NNODE0,TIUFTMSG,TIUFTLST,TIUFIMSG,SEQUENCE,SUBS,OVERRIDE,DDEFUSED
+14 SET FILEDA=TIUFINFO("FILEDA")
SET TIUFXNOD=$GET(XQORNOD(0))
+15 SET VALMBCK=""
+16 IF TIUFWHO="N"
DO FULL^VALM1
DO OVERWARN^TIUFHA2
+17 IF $PIECE(TIUFNOD0,U,13)
IF TIUFWHO'="N"
IF $PIECE(TIUFNOD0,U,4)="DOC"!($PIECE(TIUFNOD0,U,4)="CO")
WRITE !!," Parent is National, of Type TL or CO; Can't add or delete Items"
DO PAUSE^TIUFXHLX
GOTO ADDX
+18 SET (ADDFLAG,TIUFOUT1)=0
+19 ; Can't avoid redisplay since may have asked for help or answered no, not adding, in which case must erase and redisplay.
+20 FOR
Begin DoDot:1
+21 KILL MSG2
+22 ;displays list before does XE Help, so must full here
DO FULL^VALM1
+23 SET DIC("A")=$SELECT(TIUFWHO="C":"Enter Shared Component Name to add as Item: ",1:"Enter Document Definition Name to add as Item: ")
+24 SET DIC=8925.1
SET DIC(0)="AELQ"
IF TIUFWHO="C"
SET DIC(0)="AEQ"
+25 SET DIC("S")=$SELECT(TIUFWHO="C":"I $P(^(0),U,10)&($P(^(0),U,4)=""CO"")",1:$$NAMSCRN^TIUFLF2(FILEDA))
SET DLAYGO=8925.1
+26 NEW OVERRIDE
SET OVERRIDE=$$OVERRIDE^TIUFHA2("be allowed to select ANY inactive orphan item, including the wrong TYPE")
if $DATA(DIRUT)
QUIT
IF TIUFWHO="N"
IF 'OVERRIDE
WRITE !," OK, you can only select appropriate items:",!
+27 IF OVERRIDE
SET DIC("S")="I $$ORPHAN^TIUFLF4(Y,^TIU(8925.1,Y,0))=""YES"""
+28 DO ^DIC
SET TIUFY=Y
+29 IF TIUFY=-1
SET TIUFOUT1=1
QUIT
+30 SET NFILEDA=+TIUFY
SET NEWFLAG=$PIECE(TIUFY,U,3)
SET NNODE0=^TIU(8925.1,NFILEDA,0)
+31 LOCK +^TIU(8925.1,NFILEDA):1
IF '$TEST
WRITE !!,"Another user is editing item. Please try later.",!
KILL DUOUT
DO PAUSE^TIUFXHLX
QUIT
+32 IF 'NEWFLAG
IF $$STATWORD^TIUFLF5($PIECE(^TIU(8925.1,+Y,0),U,7))'="INACTIVE"
WRITE !!,"NOT inactive; Can't add Item",!
HANG 3
QUIT
+33 SET DDEFUSED=$$DDEFUSED^TIUFLF(NFILEDA)
+34 IF TIUFWHO'="N"
IF DDEFUSED="YES"
NEW DIR,Y
Begin DoDot:2
+35 ;P76 Shared component
IF $PIECE(NNODE0,U,10)
SET Y=1
QUIT
+36 IF $PIECE(NNODE0,U,4)'="DOC"
SET Y=0
QUIT
+37 SET DIR(0)="Y"
SET DIR("B")="NO"
+38 SET DIR("A",1)="WARNING: This orphan Title is already IN USE, an ABNORMAL situation. You will"
SET DIR("A",2)="have to take additional actions after adding it. You will not be able to"
SET DIR("A",3)="delete it once it is added."
+39 SET DIR("A")=" Want to go ahead and add it anyway"
WRITE !
DO ^DIR
End DoDot:2
if 'Y
QUIT
+40 NEW TIUFIMSG
IF $$DUP^TIUFLF7($PIECE(NNODE0,U),FILEDA,NFILEDA)
WRITE !!,TIUFIMSG,!
KILL DUOUT
DO PAUSE^TIUFXHLX
if NEWFLAG
DO DELETE(NFILEDA)
QUIT
+41 DO TYPELIST^TIUFLF7($PIECE(NNODE0,U),NFILEDA,FILEDA,.TIUFTMSG,.TIUFTLST)
IF $DATA(DTOUT)
if NEWFLAG
DO DELETE(NFILEDA)
QUIT
+42 ;Parent has no/wrong type
IF $DATA(TIUFTMSG("T"))
WRITE !!,TIUFTMSG("T"),!,"Can't add Item",!
KILL DUOUT
DO PAUSE^TIUFXHLX
if NEWFLAG
DO DELETE(NFILEDA)
QUIT
+43 IF TIUFTLST=""
WRITE !!," Please enter a different Name; File already has entries of every permitted Type",!,"with that Name",!
KILL DUOUT
DO PAUSE^TIUFXHLX
if NEWFLAG
DO DELETE(NFILEDA)
QUIT
+44 IF NEWFLAG
DO STUFFLDS^TIUFLF4(NFILEDA,FILEDA)
SET NNODE0=^TIU(8925.1,NFILEDA,0)
+45 WRITE !!," Editing prospective Item:",!
+46 SET EXITFLG=0
+47 IF NEWFLAG
SET FIELDS=";.05;.06;"
if $PIECE(NNODE0,U,4)=""
SET FIELDS=";.04"_FIELDS
if TIUFWHO="N"
SET FIELDS=FIELDS_".13;"
DO ASKFLDS^TIUFLF1(NFILEDA,FIELDS,FILEDA,.NEWSTAT,.EXITFLG)
if $DATA(DTOUT)
QUIT
+48 DO OWNCHEC^TIUFLF8(NFILEDA)
+49 NEW TIUFCK
+50 IF 'OVERRIDE
DO CHECK^TIUFLF3(NFILEDA,FILEDA,1,.TIUFCK)
Begin DoDot:2
+51 FOR SUBS="S","OBJ","OBJINACT","B","O","V","E","R","H","N","G","D"
KILL TIUFCK(SUBS)
+52 SET MSG1="Can't Add Item: "
+53 IF $DATA(TIUFCK)>9
SET MSG2=$PIECE(TIUFCK,U,2)
QUIT
+54 SET NNODE0=^TIU(8925.1,NFILEDA,0)
+55 IF $ORDER(^TIU(8925.1,"AD",NFILEDA,0))
IF '$PIECE(NNODE0,U,10)
SET MSG2="Item Already has Parent"
QUIT
+56 IF $DATA(^TIU(8925.1,FILEDA,10,"B",NFILEDA))
SET MSG2="Entry Already has Item"
End DoDot:2
IF $DATA(MSG2)
SET MSG=MSG1_MSG2
WRITE !!,MSG,!
KILL DUOUT
DO PAUSE^TIUFXHLX
if NEWFLAG
DO DELETE(NFILEDA)
QUIT
+57 DO ADDTEN^TIUFLF4(FILEDA,NFILEDA,NNODE0,.TENDA)
+58 IF TENDA=""
WRITE " ?? Couldn't be added! "
KILL DUOUT
DO PAUSE^TIUFXHLX
QUIT
+59 ; Adding item affects parentage globally.
IF TIUFTMPL="A"
IF $EXTRACT(TIUFATTR)="P"
SET TIUFREDO=1
+60 IF DDEFUSED'="YES"
IF 'EXITFLG
IF '$DATA(DTOUT)
SET FIELDS=";.07;"
DO ASKFLDS^TIUFLF1(NFILEDA,FIELDS,FILEDA,.NEWSTAT,.EXITFLG)
if $DATA(DTOUT)
QUIT
+61 SET DA(1)=FILEDA
SET DA=TENDA
+62 IF 'EXITFLG
IF '$DATA(DTOUT)
Begin DoDot:2
+63 LOCK +^TIU(8925.1,FILEDA,10,TENDA):1
IF '$TEST
WRITE !!,"Another user is editing item. Please edit later.",!
HANG 2
QUIT
+64 SET DIE="^TIU(8925.1,DA(1),10,"
+65 SET DR="3"
DO ^DIE
IF $DATA(Y)!$DATA(DTOUT)
QUIT
+66 ;Stuff mnem with seq value
IF $PIECE(TIUFNOD0,U,4)="CL"
SET SEQUENCE=$PIECE(^TIU(8925.1,DA(1),10,DA,0),U,3)
SET DR="2///^S X=SEQUENCE"
IF $LENGTH(SEQUENCE)<5
IF $LENGTH(SEQUENCE)
DO ^DIE
+67 SET DR=$SELECT($PIECE(TIUFNOD0,U,4)="CL":"2;4",1:4)
DO ^DIE
KILL DUOUT
End DoDot:2
LOCK -^TIU(8925.1,FILEDA,10,TENDA)
if $DATA(DTOUT)
QUIT
+68 SET MSG=" Item Added"
WRITE !,MSG,!
HANG 1
+69 IF DDEFUSED="YES"
Begin DoDot:2
+70 ;P76
IF $PIECE(NNODE0,U,10)
QUIT
+71 IF TIUFWHO'="N"
WRITE !,"WARNING: You have just added a Title which is already IN USE. Please Update",!,"Parent Document Type for this Title. If documents still seem to be missing,",!,"please contact Customer Service.",!
QUIT
+72 WRITE !,"WARNING: You have just added an item which is already IN USE. Please Update",!,"Parent Document Type for this Title/all Titles under this item. If documents"
+73 WRITE !,"are still missing, use TLDOCMTS^TIUFHA8 to reindex class cross references.",!
End DoDot:2
DO PAUSE^TIUFXHLX
+74 ; Update Template T with Item:
+75 DO INIT
if $DATA(DTOUT)
QUIT
+76 SET LINENO=$ORDER(^TMP("TIUF2IDX",$JOB,"DAF",NFILEDA,""))
+77 IF LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1))
SET VALMBG=LINENO
+78 SET ADDFLAG=1
+79 ; Update Template A with item (may be new, may be no longer Orphan):
+80 IF TIUFTMPL="A"
Begin DoDot:2
+81 ;CNTCHNG is Count Change
DO AUPDATE^TIUFLA1(NNODE0,NFILEDA,.CNTCHNG)
if CNTCHNG
SET TIUFVCN1=TIUFVCN1+1
End DoDot:2
End DoDot:1
LOCK -^TIU(8925.1,+$GET(NFILEDA))
if $DATA(DTOUT)
GOTO ADDX
SET VALMSG=$$VMSG^TIUFL
DO RE^VALM4
DO RESET^TIUFXHLX
if $DATA(DUOUT)
SET TIUFOUT1=1
if TIUFOUT1
QUIT
+82 if 'ADDFLAG
GOTO ADDX
+83 DO NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0)
if $DATA(DTOUT)
GOTO ADDX
+84 ; Template D is updated when return to it from T
+85 ; Template H doesn't need update: will just reexpand when leave items.
ADDX ;
+1 IF $DATA(DTOUT)
SET VALMBCK="Q"
+2 QUIT
+3 ;
DELETE(DA) ; Delete DA from file
+1 NEW DIK
SET DIK="^TIU(8925.1,"
DO ^DIK
+2 QUIT
