source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFA1.m@ 1500

Last change on this file since 1500 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1TIUFA1 ; SLC/MAM - LM Template A (DDEFs by Attribute) Actions Add Entry, Change View ;7/1/97 20:55
2 ;;1.0;TEXT INTEGRATION UTILITIES;**2,5**;Jun 20, 1997
3 ;
4ADD ; LM Template A action Create, LM Template J action Create
5 ;Requires TIUFATTR, TIUFAVAL, TIUFSTRT. See HDR^TIUFA
6 N DIC,DLAYGO,X,Y,FILEDA,NODE0,OPTFLDS,NEWSTAT,MSG1,MSG,TIUI,DA
7 N DIK,TENDA,CNTCHNG,LINENO,FIELDS,DTOUT,DIRUT,DIROUT
8 N TIUFY,TIUFNOD,TIUFFULL,TIUFXNOD,TIUFTMSG,TIUFTLST,NAME
9 S TIUFXNOD=$G(XQORNOD(0))
10 S VALMBCK=""
11SELECT S NAME=$$SELNAME^TIUFLF2() G:$D(DIRUT) ADDX
12 D TYPELIST^TIUFLF7(NAME,0,0,.TIUFTMSG,.TIUFTLST) G:$D(DTOUT) ADDX
13 I TIUFTMPL="J",TIUFTLST'["^O^" W !!,"Please enter a different Name; file already has Object with the same name.",! D PAUSE^TIUFXHLX G SELECT
14 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
15 S (DIC,DLAYGO)=8925.1,DIC(0)="L",X=""""_NAME_"""" D ^DIC
16 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
17 S FILEDA=+Y
18 L +^TIU(8925.1,FILEDA):1 I '$T S MSG=" Another user has accessed this entry; please finish editing later" G ADDX
19 D STUFFLDS^TIUFLF4(FILEDA)
20 S FIELDS=";.04;.05;.06;.07;"
21 I TIUFTMPL="J" S FIELDS=";.05;.06;"
22 I TIUFWHO="N" S FIELDS=FIELDS_".13;"
23 D ASKFLDS^TIUFLF1(FILEDA,FIELDS,0,.NEWSTAT)
24 N TIUFCK D CHECK^TIUFLF3(FILEDA,0,1,.TIUFCK) ;No parent
25 ; Entry is new orphan; don't worry about descendants, orphan, multiple parents, etc.
26 K MSG
27 F TIUI="T","S","A","B" D G:$D(MSG) ADDX
28 . I $D(TIUFCK(TIUI)) S MSG1=TIUFCK(TIUI),MSG="Entry deleted: ",DA=FILEDA,DIK="^TIU(8925.1," D ^DIK
29 G:$D(DTOUT) ADDX
30 D OWNCHEC^TIUFLF8(FILEDA)
31 S NODE0=$G(^TIU(8925.1,FILEDA,0))
32 D AUPDATE^TIUFLA1(NODE0,FILEDA,.CNTCHNG,.LINENO) S:CNTCHNG VALMCNT=VALMCNT+1
33 I 'CNTCHNG S MSG=" Entry added; Not in current View"
34 I CNTCHNG S MSG=" Entry added" I LINENO<VALMBG!(LINENO>(VALMBG+VALM("LINES")-1)) S VALMBG=LINENO
35 S VALMBCK="R"
36ADDX ;
37 I $D(MSG) W !!,MSG,! W:$D(MSG1) MSG1,! H 2 H:$D(MSG1) 2
38 L -^TIU(8925.1,+$G(FILEDA))
39 I $D(DTOUT) S VALMBCK="Q" Q
40 I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
41 Q
42 ;
43CHANGE ; Template A action Change View
44 N TIUFTMPA,TIUFTMPV,TIUFTMPS,TIUFXNOD,TIUFFULL,DTOUT,DIRUT,DIROUT
45 S VALMBCK="R",TIUFXNOD=$G(XQORNOD(0))
46 S TIUFTMPA=TIUFATTR,TIUFTMPV=TIUFAVAL,TIUFTMPS=TIUFSTRT
47 K TIUFATTR,TIUFAVAL,TIUFSTRT
48 ; Sets TIUFATTR,TIUFAVAL,TIUFSTRT if no ^:
49 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
50 I TIUFTMPL="J" D SELSTART^TIUFLA S TIUFATTR=TIUFTMPA,TIUFAVAL=TIUFTMPV I '$D(TIUFSTRT) S TIUFSTRT=TIUFTMPS,VALMBCK="" G CHANX
51 D INIT^TIUFA
52 K VALMHDR S VALMBG=1
53CHANX ;
54 I $D(DTOUT) S VALMBCK="Q" Q
55 I $G(TIUFFULL) S VALMBCK="R" D RESET^TIUFXHLX
56 Q
57 ;
Note: See TracBrowser for help on using the repository browser.