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