| 1 | TIUFT ; SLC/MAM - LM Template T (Items) INIT, Action Add Items ; 4-AUG-1999 10:52:47
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**2,5,17,27,77**;Jun 20, 1997
|
|---|
| 3 | HDR ; -- header code
|
|---|
| 4 | ; Requires Array TIUFNOD0.
|
|---|
| 5 | N TYPE,NAME
|
|---|
| 6 | S NAME=$P(TIUFNOD0,U)
|
|---|
| 7 | I $L(NAME)>60 S TYPE=$P(TIUFNOD0,U,4) S:TYPE="DOC" TYPE="TL" G SETHDR
|
|---|
| 8 | S TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
|
|---|
| 9 | SETHDR I TYPE'="" S TYPE=TYPE_" "
|
|---|
| 10 | S VALMHDR(1)=$$CENTER^TIUFL("Items for "_TYPE_NAME,79)
|
|---|
| 11 | HDRX Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array; Also Update.
|
|---|
| 14 | ; Requires TIUFSTMP as set in EDITEMS^TIUFD2.
|
|---|
| 15 | ; Requires CURRENT array TIUFINFO
|
|---|
| 16 | ;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
|
|---|
| 17 | ;in AUPDATE^TIUFLA1.
|
|---|
| 18 | ;WARNING: +TIUFINFO may = 0!
|
|---|
| 19 | N LINENO,FILEDA
|
|---|
| 20 | K ^TMP("TIUF2",$J),^TMP("TIUF2IDX",$J)
|
|---|
| 21 | D CLEAN^VALM10
|
|---|
| 22 | S FILEDA=TIUFINFO("FILEDA"),VALMCNT=0
|
|---|
| 23 | I '$O(^TIU(8925.1,FILEDA,10,0)) D G INITX
|
|---|
| 24 | . S ^TMP("TIUF2",$J,1,0)=""
|
|---|
| 25 | . S ^TMP("TIUF2",$J,2,0)="Entry has no items.",VALMCNT=2
|
|---|
| 26 | . Q
|
|---|
| 27 | S LINENO=0
|
|---|
| 28 | ; EDit Items checks item existence, so we know items exist in file:
|
|---|
| 29 | D BUFITEMS^TIUFLT("T",.TIUFINFO,.LINENO) G:$D(DTOUT) INITX
|
|---|
| 30 | D UPDATE^TIUFLLM1("T",LINENO,0) S VALMCNT=VALMCNT+LINENO
|
|---|
| 31 | INITX I $D(DTOUT) S VALMQUIT=1
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | EXIT ; -- exit code for LM Template T
|
|---|
| 35 | K ^TMP("TIUF2",$J),^TMP("TIUFB",$J),^TMP("TIUF2IDX",$J),^TMP("TIUFBIDX",$J)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ADD ; Template T (Items) Action Add Items
|
|---|
| 39 | ; Adds new or existing Docmt Defs to parent entry as items.
|
|---|
| 40 | ; Updates Template H or A and D as well as Item Template I.
|
|---|
| 41 | ; Requires CURRENT arrays TIUFINFO, TIUFNOD0, CURRENT variable TUIFVCN1
|
|---|
| 42 | ;as set in EDVIEW^TIUFHA, updated (if Template A has changed)
|
|---|
| 43 | ;in AUPDATE^TIUFLA1, or (if Template H has changed) in UPDATE^TIUFLLM1.
|
|---|
| 44 | ;WARNING: +TIUFINFO may = 0 if Template A has changed!
|
|---|
| 45 | ; Requires TIUFTMPL, TIUFSTMP.
|
|---|
| 46 | ; Requires TIUFWHO, set in Options TIUF/A/C/H EDIT/SORT/CREATE DDEFS CLIN/MGR/NATL.
|
|---|
| 47 | ; If TIUFTMPL ="A", Requires TIUFATTR, TIUFAVAL as set in protocols TIUF SORT BY...
|
|---|
| 48 | N FILEDA,NEWOR,ADDFLAG,DIC,DLAYGO,X,Y,NFILEDA,NEWFLAG,NEWSTAT
|
|---|
| 49 | N MSG2,MSG,MSG1,TENDA,DA,DIE,DR,CFILEDA,LINENO,DTOUT,DIRUT,DIROUT,DUOUT
|
|---|
| 50 | N CNTCHNG,FIELDS,DIK,TIUFOUT1,EXITFLG,TIUFXNOD,TIUFY,TIUFXHLX
|
|---|
| 51 | N NNODE0,TIUFTMSG,TIUFTLST,TIUFIMSG,SEQUENCE,SUBS,OVERRIDE,DDEFUSED
|
|---|
| 52 | S FILEDA=TIUFINFO("FILEDA"),TIUFXNOD=$G(XQORNOD(0))
|
|---|
| 53 | S VALMBCK=""
|
|---|
| 54 | I TIUFWHO="N" D FULL^VALM1,OVERWARN^TIUFHA2
|
|---|
| 55 | 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
|
|---|
| 56 | S (ADDFLAG,TIUFOUT1)=0
|
|---|
| 57 | ; Can't avoid redisplay since may have asked for help or answered no, not adding, in which case must erase and redisplay.
|
|---|
| 58 | 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
|
|---|
| 59 | . K MSG2
|
|---|
| 60 | . D FULL^VALM1 ;displays list before does XE Help, so must full here
|
|---|
| 61 | . S DIC("A")=$S(TIUFWHO="C":"Enter Shared Component Name to add as Item: ",1:"Enter Document Definition Name to add as Item: ")
|
|---|
| 62 | . S DIC=8925.1,DIC(0)="AELQ" I TIUFWHO="C" S DIC(0)="AEQ"
|
|---|
| 63 | . S DIC("S")=$S(TIUFWHO="C":"I $P(^(0),U,10)&($P(^(0),U,4)=""CO"")",1:$$NAMSCRN^TIUFLF2(FILEDA)),DLAYGO=8925.1
|
|---|
| 64 | . 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:",!
|
|---|
| 65 | . I OVERRIDE S DIC("S")="I $$ORPHAN^TIUFLF4(Y,^TIU(8925.1,Y,0))=""YES"""
|
|---|
| 66 | . D ^DIC S TIUFY=Y
|
|---|
| 67 | . I TIUFY=-1 S TIUFOUT1=1 Q
|
|---|
| 68 | . S NFILEDA=+TIUFY,NEWFLAG=$P(TIUFY,U,3),NNODE0=^TIU(8925.1,NFILEDA,0)
|
|---|
| 69 | . L +^TIU(8925.1,NFILEDA):1 I '$T W !!,"Another user is editing item. Please try later.",! K DUOUT D PAUSE^TIUFXHLX Q
|
|---|
| 70 | . I 'NEWFLAG,$$STATWORD^TIUFLF5($P(^TIU(8925.1,+Y,0),U,7))'="INACTIVE" W !!,"NOT inactive; Can't add Item",! H 3 Q
|
|---|
| 71 | . S DDEFUSED=$$DDEFUSED^TIUFLF(NFILEDA)
|
|---|
| 72 | . I TIUFWHO'="N",DDEFUSED="YES" N DIR,Y D Q:'Y
|
|---|
| 73 | . . I $P(NNODE0,U,10) S Y=1 Q ;P76 Shared component
|
|---|
| 74 | . . I $P(NNODE0,U,4)'="DOC" S Y=0 Q
|
|---|
| 75 | . . S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 76 | . . 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."
|
|---|
| 77 | . . S DIR("A")=" Want to go ahead and add it anyway" W ! D ^DIR
|
|---|
| 78 | . N TIUFIMSG I $$DUP^TIUFLF7($P(NNODE0,U),FILEDA,NFILEDA) W !!,TIUFIMSG,! K DUOUT D PAUSE^TIUFXHLX D:NEWFLAG DELETE(NFILEDA) Q
|
|---|
| 79 | . D TYPELIST^TIUFLF7($P(NNODE0,U),NFILEDA,FILEDA,.TIUFTMSG,.TIUFTLST) I $D(DTOUT) D:NEWFLAG DELETE(NFILEDA) Q
|
|---|
| 80 | . 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
|
|---|
| 81 | . 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
|
|---|
| 82 | . I NEWFLAG D STUFFLDS^TIUFLF4(NFILEDA,FILEDA) S NNODE0=^TIU(8925.1,NFILEDA,0)
|
|---|
| 83 | . W !!," Editing prospective Item:",!
|
|---|
| 84 | . S EXITFLG=0
|
|---|
| 85 | . 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)
|
|---|
| 86 | . D OWNCHEC^TIUFLF8(NFILEDA)
|
|---|
| 87 | . N TIUFCK
|
|---|
| 88 | . 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
|
|---|
| 89 | . . F SUBS="S","OBJ","OBJINACT","B","O","V","E","R","H","N","G","D" K TIUFCK(SUBS)
|
|---|
| 90 | . . S MSG1="Can't Add Item: "
|
|---|
| 91 | . . I $D(TIUFCK)>9 S MSG2=$P(TIUFCK,U,2) Q
|
|---|
| 92 | . . S NNODE0=^TIU(8925.1,NFILEDA,0)
|
|---|
| 93 | . . I $O(^TIU(8925.1,"AD",NFILEDA,0)),'$P(NNODE0,U,10) S MSG2="Item Already has Parent" Q
|
|---|
| 94 | . . I $D(^TIU(8925.1,FILEDA,10,"B",NFILEDA)) S MSG2="Entry Already has Item"
|
|---|
| 95 | . D ADDTEN^TIUFLF4(FILEDA,NFILEDA,NNODE0,.TENDA)
|
|---|
| 96 | . I TENDA="" W " ?? Couldn't be added! " K DUOUT D PAUSE^TIUFXHLX Q
|
|---|
| 97 | . I TIUFTMPL="A",$E(TIUFATTR)="P" S TIUFREDO=1 ; Adding item affects parentage globally.
|
|---|
| 98 | . I DDEFUSED'="YES",'EXITFLG,'$D(DTOUT) S FIELDS=";.07;" D ASKFLDS^TIUFLF1(NFILEDA,FIELDS,FILEDA,.NEWSTAT,.EXITFLG) Q:$D(DTOUT)
|
|---|
| 99 | . S DA(1)=FILEDA,DA=TENDA
|
|---|
| 100 | . I 'EXITFLG,'$D(DTOUT) D L -^TIU(8925.1,FILEDA,10,TENDA) Q:$D(DTOUT)
|
|---|
| 101 | . . L +^TIU(8925.1,FILEDA,10,TENDA):1 I '$T W !!,"Another user is editing item. Please edit later.",! H 2 Q
|
|---|
| 102 | . . S DIE="^TIU(8925.1,DA(1),10,"
|
|---|
| 103 | . . S DR="3" D ^DIE I $D(Y)!$D(DTOUT) Q
|
|---|
| 104 | . . 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
|
|---|
| 105 | . . S DR=$S($P(TIUFNOD0,U,4)="CL":"2;4",1:4) D ^DIE K DUOUT
|
|---|
| 106 | . S MSG=" Item Added" W !,MSG,! H 1
|
|---|
| 107 | . I DDEFUSED="YES" D D PAUSE^TIUFXHLX
|
|---|
| 108 | . . I $P(NNODE0,U,10) Q ;P76
|
|---|
| 109 | . . 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
|
|---|
| 110 | . . 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"
|
|---|
| 111 | . . W !,"are still missing, use TLDOCMTS^TIUFHA8 to reindex class cross references.",!
|
|---|
| 112 | . ; Update Template T with Item:
|
|---|
| 113 | . D INIT Q:$D(DTOUT)
|
|---|
| 114 | . S LINENO=$O(^TMP("TIUF2IDX",$J,"DAF",NFILEDA,""))
|
|---|
| 115 | . I LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1)) S VALMBG=LINENO
|
|---|
| 116 | . S ADDFLAG=1
|
|---|
| 117 | . ; Update Template A with item (may be new, may be no longer Orphan):
|
|---|
| 118 | . I TIUFTMPL="A" D
|
|---|
| 119 | . . D AUPDATE^TIUFLA1(NNODE0,NFILEDA,.CNTCHNG) S:CNTCHNG TIUFVCN1=TIUFVCN1+1 ;CNTCHNG is Count Change
|
|---|
| 120 | G:'ADDFLAG ADDX
|
|---|
| 121 | D NODE0ARR^TIUFLF(FILEDA,.TIUFNOD0) G:$D(DTOUT) ADDX
|
|---|
| 122 | ; Template D is updated when return to it from T
|
|---|
| 123 | ; Template H doesn't need update: will just reexpand when leave items.
|
|---|
| 124 | ADDX ;
|
|---|
| 125 | I $D(DTOUT) S VALMBCK="Q"
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | DELETE(DA) ; Delete DA from file
|
|---|
| 129 | N DIK S DIK="^TIU(8925.1," D ^DIK
|
|---|
| 130 | Q
|
|---|
