source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFUT4.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1DGPFUT4 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 1:33pm
2 ;;5.3;Registration;**554**;Aug 13, 1993
3 ;
4 Q ; no direct entry
5 ;
6BLDGLOB(DGPFDA,DGPFHX,TXN,DGPFLOUT,DGPFGOUT) ; build global
7 ;
8 ; This procedure builds the temporary global for display.
9 ; It first determines the longest label, then it steps thru the $TEXT
10 ; list of labels of fields, which control the order of nodes created.
11 ; For each label it appends the field value then adds the resulting
12 ; value to the temporary global ^TMP("DGPFARY",$J).
13 ;
14 ; Input:
15 ; DGPFDA - data array
16 ; - derived from DGPFA if called by Flag Assignment transaction
17 ; - derived from DGPFLF if called by Flag Management transaction
18 ; DGPFHX - history array
19 ; - derived from DGPFAH if called by Flag Assignment transaction
20 ; - derived from DGPFLH if called by Flag Management transaction
21 ; TXN - transaction - one of the following:
22 ; FA - FLAG ASSIGNMENT - Assign Flag
23 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
24 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
25 ; FM - FLAG MANAGEMENT - Add New Record Flag
26 ; FM - FLAG MANAGEMENT - Edit Record Flag
27 ; DGPFLOUT - (L)ocal (OUT)put array, containing non-WP fields
28 ; DGPFGOUT - (G)lobal (OUT)put array name to be built.
29 ;
30 ; Output:
31 ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
32 ; Contains assignment detail
33 ; This global is displayed to screen for user.
34 ;
35 ; Temporary variables:
36 N DGPFROOT ; Array root subscript
37 N DGPFCOL ; Column value for each display field, stored in text block
38 N DGPFLABL ; Label of DGPFROOT for display
39 N DGPFVAL ; Value from DGPFROOT array node
40 N DGPFPAD ; Holds padded spaces for display alignment
41 N DGPFOFST ; Offset of text line in text subroutine
42 N DGPFLONG ; Longest label for later display
43 N DGPFLINE ; Line number incremented during final global build in SET
44 N DGPFRTN ; Routine that contains the TEXT from which to read
45 N DGPFTEXT ; value of text line retrieved from TEXT
46 N DGPFTAG ; tag at offset of TEXT
47 N DGPFSR ; TEXT subroutine to use to acquire data
48 N DGPFPICT ; count of number of times PRININV array has been read
49 ;
50 S DGPFLINE=0
51 S DGPFRTN=$P(TXN,U)_"TXT"
52 S DGPFPICT=0
53 ;
54 ; determine longest label - set this value into the variable DGPFLONG:
55 S DGPFLONG=1
56 F DGPFOFST=2:1 D Q:DGPFROOT=""!(DGPFROOT="QUIT")
57 . S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
58 . S DGPFROOT=$P(DGPFTEXT,";",3)
59 . Q:DGPFROOT=""!(";DESC;NARR;COMMENT;REASON;QUIT;"[(";"_DGPFROOT_";"))
60 . I DGPFROOT="PRININV",'$D(DGPFLOUT(DGPFROOT)) Q
61 . S DGPFLABL=$P(DGPFTEXT,";",5)
62 . S DGPFLONG=$S($L(DGPFLABL)+1>DGPFLONG:$L(DGPFLABL)+1,1:DGPFLONG)
63 ;
64 ; step thru the text - this controls the order of display
65 F DGPFOFST=2:1 D Q:DGPFROOT=""!(DGPFROOT="QUIT")
66 . S DGPFTAG=DGPFRTN_"+"_DGPFOFST,DGPFTEXT=$T(@DGPFTAG)
67 . S DGPFROOT=$P(DGPFTEXT,";",3)
68 . S DGPFLABL=$P(DGPFTEXT,";",5)
69 . Q:DGPFROOT=""!(DGPFROOT="QUIT")
70 . ;
71 . ; build array from Principal Investigator multiple
72 . I DGPFROOT="PRININV" D Q
73 . . D BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
74 . ;
75 . ; build array from word-processing multiple:
76 . I ";DESC;NARR;COMMENT;REASON;"[(";"_DGPFROOT_";") D Q
77 . . D BLDWP(DGPFROOT,DGPFLABL,.DGPFLINE,.DGPFLOUT,DGPFGOUT)
78 . ;
79 . S DGPFCOL=DGPFLONG-$L(DGPFLABL)
80 . S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL)
81 . S DGPFVAL=DGPFPAD_DGPFLABL_DGPFLOUT(DGPFROOT)
82 . ;
83 . S DGPFLINE=DGPFLINE+1
84 . S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
85 Q
86 ;
87BLDPI(DGPFROOT,DGPFLABL,DGPFLONG,DGPFLINE,DGPFLOUT,DGPFGOUT) ;
88 ;
89 ; Add each of the nodes from the PRININV array multiple to temp global.
90 ;
91 ; Input:
92 ; DGPFROOT - Name of the field derived from the $TEXT segment below
93 ; DGPFLABL - Label
94 ; DGPFLONG - Contains length of longest label
95 ; DGPFLINE - Line number for incrementing of global array nodes
96 ; DGPFLOUT - Local array of WP text
97 ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
98 ;
99 ; Output:
100 ; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
101 ;
102 ; Temporary variables:
103 N DGPFSUB ; subscript
104 N DGPFPAD ; padding for leading spaces for display
105 N DGPFCOL ; column value for Principal Investigator label
106 N DGPFVAL ; value from DGPFROOT array node
107 ;
108 S DGPFCOL=DGPFLONG-$L(DGPFLABL)
109 S DGPFPAD=$E($J("",DGPFCOL),1,DGPFCOL)
110 ;
111 S DGPFSUB=""
112 F S DGPFSUB=$O(DGPFLOUT(DGPFROOT,DGPFSUB)) Q:'DGPFSUB D
113 . S DGPFVAL=DGPFPAD_DGPFLABL_$G(DGPFLOUT(DGPFROOT,DGPFSUB,0))
114 . ;
115 . S DGPFLINE=DGPFLINE+1
116 . S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
117 Q
118 ;
119BLDWP(DGPFROOT,DGPFLABL,DGPFLINE,DGPFLOUT,DGPFGOUT) ;build WP array
120 ;
121 ; This procedure adds each of the nodes from the word-processing
122 ; multiple to the temp global (^TMP).
123 ;
124 ; Input:
125 ; DGPFROOT - Name of the field derived from the $TEXT segment below
126 ; DGPFLABL - label
127 ; DGPFLINE - Line number for incrementing of global array nodes
128 ; DGPFLOUT - Local array of WP text to be added to the global array
129 ; DGPFGOUT - (G)lobal (OUT)put - name of ^TMP global built
130 ;
131 ; Output:
132 ; none - build DGPFGOUT - (G)lobal (OUT)put ^TMP global
133 ;
134 ; Temporary variables:
135 N DGSUB ; subscript value in word processing fields
136 N DGPFPAD ; Padding as spaces for alignment of headers
137 N DGPFVAL ; value from DGPFROOT array node
138 ;
139 S DGPFPAD=" "
140 ;
141 ; insert header for narrative:
142 S DGPFVAL=DGPFPAD_DGPFLABL
143 ;
144 S DGPFLINE=DGPFLINE+1
145 S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
146 ;
147 ; set each word processing line
148 S DGSUB=0
149 F S DGSUB=$O(DGPFLOUT(DGPFROOT,DGSUB)) Q:'DGSUB D
150 . S DGPFVAL=DGPFPAD_$G(DGPFLOUT(DGPFROOT,DGSUB,0))
151 . ;
152 . S DGPFLINE=DGPFLINE+1
153 . S @DGPFGOUT@(DGPFLINE,0)=DGPFVAL
154 Q
155 ;
156FATXT ; ordered list of fields to be presented to user for Flag Assignment
157 ;;ROOT; ;LABEL;
158 ;;PATIENT; ;Patient Name: ;
159 ;;FLAGNAME; ;Flag Name: ;
160 ;;FLAGTYPE; ;Flag Type: ;
161 ;;CATEGORY; ;Flag Category: ;
162 ;;STATUS; ;Assignment Status: ;
163 ;;INITASSIGN; ;Initial Assignment: ;
164 ;;LASTREVIEW; ;Last Review Date: ;
165 ;;REVIEWDT; ;Next Review Date: ;
166 ;;OWNER; ;Owner Site: ;
167 ;;ORIGSITE; ;Originating Site: ;
168 ;;ACTION; ;Assignment Action: ;
169 ;;ACTIONDT; ;Action Date: ;
170 ;;ENTERBY; ;Entered By: ;
171 ;;APPRVBY; ;Approved By: ;
172 ;;NARR; ;Record Flag Assignment Narrative: ;
173 ;;COMMENT; ;Action Comments: ;
174 ;;QUIT;
175 Q
176 ;
177FMTXT ; ordered list of fields to be presented to user for Flag Management
178 ;;ROOT; ;LABEL;
179 ;;FLAGNAME; ;Flag Name: ;
180 ;;CATEGORY; ;Flag Category: ;
181 ;;FLAGTYPE; ;Flag Type: ;
182 ;;STATUS; ;Flag Status: ;
183 ;;REVFREQ; ;Review Frequency Days: ;
184 ;;NOTIDAYS; ;Notification Days: ;
185 ;;REVGRP; ;Review Mail Group: ;
186 ;;TIUTITLE; ;Progress Note Title: ;
187 ;;ENTERDT; ;Enter/Edit On: ;
188 ;;ENTERBY; ;Enter/Edit By: ;
189 ;;PRININV; ;Principal Investigator(s): ;
190 ;;DESC; ;Flag Description: ;
191 ;;REASON; ;Reason For Flag Enter/Edit: ;
192 ;;QUIT;
193 Q
Note: See TracBrowser for help on using the repository browser.