TIUFA1 ; SLC/MAM - LM Template A (DDEFs by Attribute) Actions Add Entry, Change View ;7/1/97 20:55
;;1.0;TEXT INTEGRATION UTILITIES;**2,5**;Jun 20, 1997
;
ADD ; LM Template A action Create, LM Template J action Create
;Requires TIUFATTR, TIUFAVAL, TIUFSTRT. See HDR^TIUFA
N DIC,DLAYGO,X,Y,FILEDA,NODE0,OPTFLDS,NEWSTAT,MSG1,MSG,TIUI,DA
N DIK,TENDA,CNTCHNG,LINENO,FIELDS,DTOUT,DIRUT,DIROUT
N TIUFY,TIUFNOD,TIUFFULL,TIUFXNOD,TIUFTMSG,TIUFTLST,NAME
S TIUFXNOD=$G(XQORNOD(0))
S VALMBCK=""
SELECT S NAME=$$SELNAME^TIUFLF2() G:$D(DIRUT) ADDX
D TYPELIST^TIUFLF7(NAME,0,0,.TIUFTMSG,.TIUFTLST) G:$D(DTOUT) ADDX
I TIUFTMPL="J",TIUFTLST'["^O^" W !!,"Please enter a different Name; file already has Object with the same name.",! D PAUSE^TIUFXHLX G SELECT
I TIUFTMPL'="J",TIUFTLST="" W !!,"Please enter a different Name; file already has entry of every type with the",!,"same name.",! D PAUSE^TIUFXHLX G SELECT
S (DIC,DLAYGO)=8925.1,DIC(0)="L",X=""""_NAME_"""" D ^DIC
I Y=-1 W !,"?? " W:TIUFTMPL="J" "Object Name must be different from all other object Names, Abbreviations,",!,"and Print Names.",! W:TIUFTMPL'="J" "Couldn't Add Entry; See IRM",! D PAUSE^TIUFXHLX G ADDX
S FILEDA=+Y
L +^TIU(8925.1,FILEDA):1 I '$T S MSG=" Another user has accessed this entry; please finish editing later" G ADDX
D STUFFLDS^TIUFLF4(FILEDA)
S FIELDS=";.04;.05;.06;.07;"
I TIUFTMPL="J" S FIELDS=";.05;.06;"
I TIUFWHO="N" S FIELDS=FIELDS_".13;"
D ASKFLDS^TIUFLF1(FILEDA,FIELDS,0,.NEWSTAT)
N TIUFCK D CHECK^TIUFLF3(FILEDA,0,1,.TIUFCK) ;No parent
; Entry is new orphan; don't worry about descendants, orphan, multiple parents, etc.
K MSG
F TIUI="T","S","A","B" D G:$D(MSG) ADDX
. I $D(TIUFCK(TIUI)) S MSG1=TIUFCK(TIUI),MSG="Entry deleted: ",DA=FILEDA,DIK="^TIU(8925.1," D ^DIK
G:$D(DTOUT) ADDX
D OWNCHEC^TIUFLF8(FILEDA)
S NODE0=$G(^TIU(8925.1,FILEDA,0))
D AUPDATE^TIUFLA1(NODE0,FILEDA,.CNTCHNG,.LINENO) S:CNTCHNG VALMCNT=VALMCNT+1
I 'CNTCHNG S MSG=" Entry added; Not in current View"
I CNTCHNG S MSG=" Entry added" I LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1)) S VALMBG=LINENO
S VALMBCK="R"
ADDX ;
I $D(MSG) W !!,MSG,! W:$D(MSG1) MSG1,! H 2 H:$D(MSG1) 2
L -^TIU(8925.1,+$G(FILEDA))
I $D(DTOUT) S VALMBCK="Q" Q
I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
Q
;
CHANGE ; Template A action Change View
N TIUFTMPA,TIUFTMPV,TIUFTMPS,TIUFXNOD,TIUFFULL,DTOUT,DIRUT,DIROUT
S VALMBCK="R",TIUFXNOD=$G(XQORNOD(0))
S TIUFTMPA=TIUFATTR,TIUFTMPV=TIUFAVAL,TIUFTMPS=TIUFSTRT
K TIUFATTR,TIUFAVAL,TIUFSTRT
; Sets TIUFATTR,TIUFAVAL,TIUFSTRT if no ^:
I TIUFTMPL="A" S X=^TMP("TIUF",$J,"SORTCM")_";ORD(101," D EN^XQOR I '$D(TIUFSTRT) S TIUFATTR=TIUFTMPA,TIUFAVAL=TIUFTMPV,TIUFSTRT=TIUFTMPS,VALMBCK="" G CHANX
I TIUFTMPL="J" D SELSTART^TIUFLA S TIUFATTR=TIUFTMPA,TIUFAVAL=TIUFTMPV I '$D(TIUFSTRT) S TIUFSTRT=TIUFTMPS,VALMBCK="" G CHANX
D INIT^TIUFA
K VALMHDR S VALMBG=1
CHANX ;
I $D(DTOUT) S VALMBCK="Q" Q
I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUFA1 3013 printed Dec 13, 2024@02:40:33 Page 2
TIUFA1 ; SLC/MAM - LM Template A (DDEFs by Attribute) Actions Add Entry, Change View ;7/1/97 20:55
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**2,5**;Jun 20, 1997
+2 ;
ADD ; LM Template A action Create, LM Template J action Create
+1 ;Requires TIUFATTR, TIUFAVAL, TIUFSTRT. See HDR^TIUFA
+2 NEW DIC,DLAYGO,X,Y,FILEDA,NODE0,OPTFLDS,NEWSTAT,MSG1,MSG,TIUI,DA
+3 NEW DIK,TENDA,CNTCHNG,LINENO,FIELDS,DTOUT,DIRUT,DIROUT
+4 NEW TIUFY,TIUFNOD,TIUFFULL,TIUFXNOD,TIUFTMSG,TIUFTLST,NAME
+5 SET TIUFXNOD=$GET(XQORNOD(0))
+6 SET VALMBCK=""
SELECT SET NAME=$$SELNAME^TIUFLF2()
if $DATA(DIRUT)
GOTO ADDX
+1 DO TYPELIST^TIUFLF7(NAME,0,0,.TIUFTMSG,.TIUFTLST)
if $DATA(DTOUT)
GOTO ADDX
+2 IF TIUFTMPL="J"
IF TIUFTLST'["^O^"
WRITE !!,"Please enter a different Name; file already has Object with the same name.",!
DO PAUSE^TIUFXHLX
GOTO SELECT
+3 IF TIUFTMPL'="J"
IF TIUFTLST=""
WRITE !!,"Please enter a different Name; file already has entry of every type with the",!,"same name.",!
DO PAUSE^TIUFXHLX
GOTO SELECT
+4 SET (DIC,DLAYGO)=8925.1
SET DIC(0)="L"
SET X=""""_NAME_""""
DO ^DIC
+5 IF Y=-1
WRITE !,"?? "
if TIUFTMPL="J"
WRITE "Object Name must be different from all other object Names, Abbreviations,",!,"and Print Names.",!
if TIUFTMPL'="J"
WRITE "Couldn't Add Entry; See IRM",!
DO PAUSE^TIUFXHLX
GOTO ADDX
+6 SET FILEDA=+Y
+7 LOCK +^TIU(8925.1,FILEDA):1
IF '$TEST
SET MSG=" Another user has accessed this entry; please finish editing later"
GOTO ADDX
+8 DO STUFFLDS^TIUFLF4(FILEDA)
+9 SET FIELDS=";.04;.05;.06;.07;"
+10 IF TIUFTMPL="J"
SET FIELDS=";.05;.06;"
+11 IF TIUFWHO="N"
SET FIELDS=FIELDS_".13;"
+12 DO ASKFLDS^TIUFLF1(FILEDA,FIELDS,0,.NEWSTAT)
+13 ;No parent
NEW TIUFCK
DO CHECK^TIUFLF3(FILEDA,0,1,.TIUFCK)
+14 ; Entry is new orphan; don't worry about descendants, orphan, multiple parents, etc.
+15 KILL MSG
+16 FOR TIUI="T","S","A","B"
Begin DoDot:1
+17 IF $DATA(TIUFCK(TIUI))
SET MSG1=TIUFCK(TIUI)
SET MSG="Entry deleted: "
SET DA=FILEDA
SET DIK="^TIU(8925.1,"
DO ^DIK
End DoDot:1
if $DATA(MSG)
GOTO ADDX
+18 if $DATA(DTOUT)
GOTO ADDX
+19 DO OWNCHEC^TIUFLF8(FILEDA)
+20 SET NODE0=$GET(^TIU(8925.1,FILEDA,0))
+21 DO AUPDATE^TIUFLA1(NODE0,FILEDA,.CNTCHNG,.LINENO)
if CNTCHNG
SET VALMCNT=VALMCNT+1
+22 IF 'CNTCHNG
SET MSG=" Entry added; Not in current View"
+23 IF CNTCHNG
SET MSG=" Entry added"
IF LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1))
SET VALMBG=LINENO
+24 SET VALMBCK="R"
ADDX ;
+1 IF $DATA(MSG)
WRITE !!,MSG,!
if $DATA(MSG1)
WRITE MSG1,!
HANG 2
if $DATA(MSG1)
HANG 2
+2 LOCK -^TIU(8925.1,+$GET(FILEDA))
+3 IF $DATA(DTOUT)
SET VALMBCK="Q"
QUIT
+4 IF $GET(TIUFFULL)
SET VALMBCK="R"
DO RESET^TIUFXHLX
+5 QUIT
+6 ;
CHANGE ; Template A action Change View
+1 NEW TIUFTMPA,TIUFTMPV,TIUFTMPS,TIUFXNOD,TIUFFULL,DTOUT,DIRUT,DIROUT
+2 SET VALMBCK="R"
SET TIUFXNOD=$GET(XQORNOD(0))
+3 SET TIUFTMPA=TIUFATTR
SET TIUFTMPV=TIUFAVAL
SET TIUFTMPS=TIUFSTRT
+4 KILL TIUFATTR,TIUFAVAL,TIUFSTRT
+5 ; Sets TIUFATTR,TIUFAVAL,TIUFSTRT if no ^:
+6 IF TIUFTMPL="A"
SET X=^TMP("TIUF",$JOB,"SORTCM")_";ORD(101,"
DO EN^XQOR
IF '$DATA(TIUFSTRT)
SET TIUFATTR=TIUFTMPA
SET TIUFAVAL=TIUFTMPV
SET TIUFSTRT=TIUFTMPS
SET VALMBCK=""
GOTO CHANX
+7 IF TIUFTMPL="J"
DO SELSTART^TIUFLA
SET TIUFATTR=TIUFTMPA
SET TIUFAVAL=TIUFTMPV
IF '$DATA(TIUFSTRT)
SET TIUFSTRT=TIUFTMPS
SET VALMBCK=""
GOTO CHANX
+8 DO INIT^TIUFA
+9 KILL VALMHDR
SET VALMBG=1
CHANX ;
+1 IF $DATA(DTOUT)
SET VALMBCK="Q"
QUIT
+2 IF $GET(TIUFFULL)
SET VALMBCK="R"
DO RESET^TIUFXHLX
+3 QUIT
+4 ;
