source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUFD.m@ 1801

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

initial load of WorldVistAEHR
File size: 7.2 KB
RevLine 
[613]1TIUFD ; SLC/MAM - LM Screen D (Display) INIT, DS/BASICS,ITEMS,PARNT,BOILTX,TECH(LASTLIN) ;02/16/06
2 ;;1.0;TEXT INTEGRATION UTILITIES;**14,184,211**;Jun 20, 1997;Build 26
3 ;
4HDR ; -- header code
5 S VALMHDR(1)=$$FHDR
6HDRX ;
7 Q
8 ;
9FHDR() ; Function returns Type_Name for headers; Requires Array TIUFNOD0.
10 N NAME,TYPE
11 S NAME=$P(TIUFNOD0,U)
12 S TYPE=$$MIXED^TIULS(TIUFNOD0("TYPE"))
13 I TYPE'="" S TYPE=TYPE_" "
14 Q $$CENTER^TIUFL(TYPE_NAME,79)
15 ;
16INIT ; -- init variables and list array
17 N TEMPLATE
18 K ^TMP("TIUF3",$J),^TMP("TIUF3IDX",$J)
19 D CLEAN^VALM10
20 S VALMCNT=0 D DSBASICS(.VALMCNT)
21INITX I $D(DTOUT) S VALMQUIT=1
22 Q
23 ;
24DSBASICS(LASTLIN) ; Set/Update Display Array TIUF3 starting with Basics.
25 ; Requires LASTLIN = Last array line set, if setting array; = Last
26 ;line to keep before resetting the rest if resetting array.
27 ; Updates LASTLIN to Last array line set by this module.
28 ; Requires CURRENT arrays TIUFINFO, TIUFNOD0.
29 ;WARNING: +TIUFINFO may = 0!
30 ; Any blanklines are set at the beginning, not the end, of the module.
31 N LINENO,CNT,TIUI,FILEDA,LP,LC,OWNER,DA,DR,TYPE,DIC,DIQ,FLDNO
32 S LINENO=LASTLIN
33 ;If called to redisplay edited screen rather than by Init, kill array starting with Basics before resetting array.
34 S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
35 F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
36 S FILEDA=TIUFINFO("FILEDA"),TYPE=$P(TIUFNOD0,U,4)
37 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Basics"_$S(TYPE'="O":" Note: Values preceded by * have been inherited",1:"")
38 K TIUFQ
39 S DIC=8925.1,DR=".01:.15;3.02;3.03;1501",DIQ(0)="I,E",DA=FILEDA,DIQ="TIUFQ" D EN^DIQ1 ;P184
40 F FLDNO=.01,1501,.02,.03,.04,.1,0,.13,.07,.05,.11,.08,.15,3.02,3.03 D
41 . I FLDNO=0,"NM"'[TIUFWHO Q ;Sets IFN line.
42 . I FLDNO=.1,TYPE'="CO" Q
43 . I FLDNO=.11,TIUFTMPL'="A"!(TYPE="O") Q
44 . I FLDNO=3.03,TYPE="CO"!(TYPE="O")!(TIUFWHO="C") Q
45 . I FLDNO=3.02,"N"'[TIUFWHO Q ; For now, include OK to Distribute only on Natl options. MAM
46 . D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
47 . Q
48 K TIUFQ
49DSBAX S LASTLIN=LINENO Q:$D(DTOUT) D DSPARNT(.LASTLIN)
50 Q
51 ;
52DSPARNT(LASTLIN) ; Set/Update Display Array TIUF3 starting with Parents.
53 ; See DSBASICS for required variables, etc.
54 N LINENO,CNT,TIUI,FILEDA,TIUREC,INFO,NODE0,TYPE,OLDLNO,PARENT
55 S (TIUFPLIN,LINENO)=LASTLIN,FILEDA=TIUFINFO("FILEDA"),TYPE=$P(TIUFNOD0,U,4)
56 I TYPE="O" G DSPAX
57 ; Don't display parents if Template H or C, unless SHARED CO OR (mistakenly) Multiple Parents:
58 I "HC"[TIUFTMPL,'((TYPE="CO")&$P(TIUFNOD0,U,10)) S PARENT=+$O(^TIU(8925.1,"AD",FILEDA,0)) I '$O(^TIU(8925.1,"AD",FILEDA,PARENT)) G DSPAX
59 ;If called to redisplay edited screen rather than by Init, kill array starting with Parents before resetting array.
60 S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
61 F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
62 S FILEDA=TIUFINFO("FILEDA")
63 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
64 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Parent"_$S(TIUFNOD0("SHARE")="":"",1:"s")_$S($O(^TIU(8925.1,"AD",FILEDA,0)):" Type IFN Natl Status Owner",1:"")
65 I '$O(^TIU(8925.1,"AD",FILEDA,0)) S LASTLIN=LINENO G DSPAX
66 S TIUI=0,OLDLNO=LINENO
67 F S TIUI=$O(^TIU(8925.1,"AD",FILEDA,TIUI)) Q:'TIUI D G:$D(DTOUT) DSPAX
68 . S LINENO=LINENO+1 D NINFO^TIUFLLM(LINENO,TIUI,.INFO),PARSE^TIUFLLM(.INFO),NODE0ARR^TIUFLF(TIUI,.NODE0) Q:$D(DTOUT)
69 . I NODE0="" W !!," Entry "_FILEDA_" has parent missing from the file.",! S LINENO=LINENO-1 D PAUSE^TIUFXHLX Q
70 . D BUFENTRY^TIUFLLM2(.INFO,.NODE0,"80")
71 . Q
72 D UPDATE^TIUFLLM1("D",LINENO-OLDLNO,OLDLNO)
73DSPAX S LASTLIN=LINENO Q:$D(DTOUT) D DSITEMS(.LASTLIN)
74 Q
75 ;
76DSITEMS(LASTLIN) ; Set/Update Display Array TIUF3 starting with Items.
77 ; See DSBASICS for required variables, etc.
78 ; Called by subtemplates D AND T
79 N LINENO,CNT,TIUI,FILEDA,TIUREC,ITEMS,OLDLNO,HASITEMS
80 S (TIUFILIN,LINENO)=LASTLIN
81 G:TIUFNOD0("ITEMS")="" DSITX ; Items is NA
82 ;If called to redisplay edited screen rather than by Init, kill array starting with Items before resetting array.
83 S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
84 F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
85 S FILEDA=TIUFINFO("FILEDA")
86 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
87 ; HASITEMS may have changed if edited items:
88 S ITEMS=" Items",HASITEMS=$$HASITEMS^TIUFLF1(FILEDA) I HASITEMS S ITEMS=ITEMS_" (By Sequence if they have it, otherwise alphabetically by Menu Text)"
89 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=ITEMS
90 I 'HASITEMS G DSITX
91 S TIUREC=$$SETSTR^VALM1("Item","",2,37)
92 S:"NM"[TIUFWHO TIUREC=$$SETSTR^VALM1(" IFN",TIUREC,32,7)
93 S TIUREC=$$SETSTR^VALM1("Seq ",TIUREC,41,6),TIUREC=$$SETSTR^VALM1("Mnem",TIUREC,49,4),TIUREC=$$SETSTR^VALM1("Menu Text",TIUREC,55,26)
94 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=TIUREC,OLDLNO=LINENO
95 ; Checked for items existing before entered EDIT/View. So items exist:
96 D BUFITEMS^TIUFLT("D",.TIUFINFO,.LINENO) G:$D(DTOUT) DSITX
97 D UPDATE^TIUFLLM1("D",LINENO-OLDLNO,OLDLNO)
98DSITX S LASTLIN=LINENO Q:$D(DTOUT) D DSBOILTX(.LASTLIN)
99 Q
100 ;
101DSBOILTX(LASTLIN) ; Set Display Array TIUF3 starting with Boilerplte Text.
102 ; Used by subtemplates D and X AND T
103 ; See DSBASICS for required variables, etc.
104 N LINENO,CNT,TIUI,FILEDA,NAME
105 S (TIUFBLIN,LINENO)=LASTLIN
106 G:TIUFNOD0("BOILPT")="" DSBOX ; NA
107 ;If called to redisplay edited screen rather than by Init, kill array starting with Boilpt Txt before resetting array.
108 S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
109 F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
110 S FILEDA=TIUFINFO("FILEDA")
111 I TIUFSTMP'="X" S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)="",LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Boilerplate Text"
112 I TIUFNOD0("TYPE")="COMPONENT" S NAME=$P(TIUFNOD0,U),LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=NAME_":"
113 D SETBOIL^TIUFLD1(FILEDA,.LINENO)
114 D DSETBOIL^TIUFLD1(FILEDA,.LINENO)
115DSBOX S LASTLIN=LINENO Q:$D(DTOUT) D:TIUFSTMP'="X" DSTECH(.LASTLIN)
116 Q
117 ;
118DSTECH(LASTLIN) ; Set/Update Display Array TIUF3 starting with Technical Flds.
119 ; See DSBASICS for required variables, etc.
120 ; Called by subtemp D and T
121 N LINENO,CNT,TIUI,FILEDA,FLDNO,PFILEDA,PNODE61,PCUSTOM,TYPE
122 N DIC,DR,DIQ,DA
123 S (TIUFTLIN,LINENO)=LASTLIN
124 I "NM"'[TIUFWHO G DSTEX
125 S TYPE=$P(TIUFNOD0,U,4) I TYPE="CO" G DSTEX
126 ;If called to redisplay edited screen rather than by Init, kill array starting with Tech flds before resetting array.
127 S CNT=$O(^TMP("TIUF3",$J,1000000),-1)
128 F TIUI=LASTLIN+1:1:CNT K ^TMP("TIUF3",$J,TIUI),^TMP("TIUF3IDX",$J,TIUI)
129 S FILEDA=TIUFINFO("FILEDA")
130 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=""
131 S LINENO=LINENO+1,^TMP("TIUF3",$J,LINENO,0)=" Technical Fields"_$S(TYPE'="O":" Note: Values preceded by * have been inherited",1:"")
132 K TIUFQ
133 S DIC=8925.1,DR="4.1:4.45;4.6;4.7;4.9;5:9",DIQ(0)="I,E",DA=FILEDA,DIQ="TIUFQ" D EN^DIQ1
134 I TYPE="O" D SETFLD^TIUFLD(FILEDA,.LINENO,9) G DSTEX
135 S PFILEDA=+$O(^TIU(8925.1,"AD",FILEDA,0))
136 I TYPE="CL"!(TYPE="DC")!(TYPE="DOC") S PNODE61=$G(^TIU(8925.1,PFILEDA,6.1)),PCUSTOM=$P(PNODE61,U,4) I PCUSTOM="" D INHERIT^TIUFLD(FILEDA,0,6.14,"","","",.PCUSTOM)
137 F FLDNO=4.1,4.2,4.3,4.4,4.45,4.6,4.7,4.9,5,6,6.1,6.12,6.13,7,8,6.14 D
138 . I FLDNO=6.14,TYPE'="CL",TYPE'="DC" Q
139 . I FLDNO=6.1!(FLDNO=6.12)!(FLDNO=6.13),'$G(PCUSTOM) Q
140 . D SETFLD^TIUFLD(FILEDA,.LINENO,FLDNO)
141 . Q
142DSTEX K TIUFQ S LASTLIN=LINENO Q:$D(DTOUT) D DSEMBED^TIUFD1(.LASTLIN)
143 Q
144 ;
Note: See TracBrowser for help on using the repository browser.