- 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
- 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
