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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1DGPFUT3 ;ALB/SAE - PRF UTILITIES CONTINUED ; 6/9/04 5:06pm
2 ;;5.3;Registration;**554**;Aug 13, 1993
3 ;
4 Q ; no direct entry
5 ;
6REVIEW(DGPFDA,DGPFHX,DGPFIEN,DGPFOPT,DGPFACT) ; Entry point for review display
7 ;
8 ; This is the driver routine for redisplaying entry detail to the user
9 ; for their review before filing a new or edited PRF Flag or PRF Flag
10 ; Assignment record.
11 ;
12 ; This routine builds the temporary array which is then used to
13 ; create the temporary global for review by the user.
14 ;
15 ; Called from the following options and actions:
16 ; Option Action Calling Routine
17 ; RECORD FLAG ASSIGNMENT ASSIGN FLAG AF^DGPFLMA2
18 ; RECORD FLAG ASSIGNMENT EDIT FLAG ASSIGNMENT EF^DGPFLMA3
19 ; RECORD FLAG ASSIGNMENT CHANGE ASSIGNMENT OWNERSHIP CO^DGPFLMA4
20 ; RECORD FLAG MANAGEMENT ADD NEW RECORD FLAG AF^DGPFLF3
21 ; RECORD FLAG MANAGEMENT EDIT RECORD FLAG EF^DGPFLF5
22 ;
23 ; Input:
24 ; DGPFDA - data array
25 ; - derived from DGPFA if called by Flag Assignment transaction
26 ; - derived from DGPFLF if called by Flag Management transaction
27 ; DGPFHX - history array
28 ; - derived from DGPFAH if called by Flag Assignment transaction
29 ; - derived from DGPFLH if called by Flag Management transaction
30 ; DGPFIEN - IEN of the Flag Assignment for EF and CO
31 ; - this will be null for all other calls to this routine
32 ; DGPFOPT - XQY0 variable for option name - used for headers
33 ; DGPFACT - XQORNOD(0) variable for action name - used for headers
34 ;
35 ; Output:
36 ; none - A temporary global is built and displayed.
37 ;
38 ; Temporary variables:
39 N TXN ; transaction - one of the following:
40 ; FA - FLAG ASSIGNMENT - Assign Flag
41 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
42 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
43 ; FM - FLAG MANAGEMENT - Add New Record Flag
44 ; FM - FLAG MANAGEMENT - Edit Record Flag
45 ;
46 N DGPFLOUT ; (L)ocal(OUT)put array with values needed to setup global
47 N DGPFGOUT ; (G)lobal (OUT)put array name. Contains assignment detail
48 ;
49 S TXN=$S($P(DGPFOPT,U)["FLAG ASSIGNMENT":"FA",1:"FM")
50 S TXN=TXN_U_$P($P(DGPFOPT,U),"DGPF ",2)
51 S TXN=TXN_U_$P(DGPFACT,U,3,4)
52 ;
53 S DGPFGOUT=$NA(^TMP("DGPFARY",$J)) K @DGPFGOUT
54 S DGPFLOUT("ASGMNTIEN")=DGPFIEN
55 ;
56 D BLDLOCAL(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT)
57 D BLDGLOB^DGPFUT4(.DGPFDA,.DGPFHX,TXN,.DGPFLOUT,DGPFGOUT)
58 D DISPLAY^DGPFUT5(TXN,DGPFGOUT) ; order thru global, display to user
59 ;
60 K @DGPFGOUT ; remove temporary global array
61 Q
62 ;
63BLDLOCAL(DGPFDA,DGPFHX,TXN,DGPFLOUT) ;
64 ; This procedure builds a local array (DPGFLOUT) of all fields
65 ;
66 ; Input:
67 ; DGPFDA - flag assignment data array
68 ; DGPFHX - flag assignment history array
69 ; TXN - transaction containing current option and action
70 ; DGPFLOUT - Local Output array
71 ;
72 ; Output:
73 ; none
74 ;
75 I $P(TXN,U)="FA" D BLDLOCFA(.DGPFDA,.DGPFHX,.DGPFLOUT) ; bld local array
76 I $P(TXN,U)="FM" D BLDLOCFM(.DGPFDA,.DGPFHX,.DGPFLOUT) ; bld local array
77 Q
78 ;
79BLDLOCFA(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
80 ;
81 ; This procedure builds a local array (DPGFLOUT) of all
82 ; FLAG ASSIGNMENT fields to be presented to the user.
83 ;
84 ; Input:
85 ; DGPFDA - flag assignment data array
86 ; DGPFHX - flag assignment history array
87 ; DGPFLOUT - Local Output array
88 ;
89 ; Output:
90 ; DGPFLOUT - (L)ocal (OUT)put array
91 ;
92 ; Temporary variables:
93 N DGPFIEN ; Internal Entry Number
94 N DGPFPAT ; patient data array
95 N DGPFFLG ; flag data array
96 N DGPFAHX ; temporary array for holding last assignment
97 N DGPFIA ; initial assignment internal value
98 N DGPFLAST ; last assignment
99 ;
100 Q:'$$GETPAT^DGPFUT2($P(DGPFDA("DFN"),U),.DGPFPAT)
101 Q:'$$GETFLAG^DGPFUT1($P($G(DGPFDA("FLAG")),U),.DGPFFLG)
102 ;
103 S DGPFLOUT("PATIENT")=$G(DGPFPAT("NAME"))
104 S DGPFLOUT("FLAGNAME")=$P($G(DGPFFLG("FLAG")),U)
105 S DGPFLOUT("FLAGTYPE")=$P($G(DGPFFLG("TYPE")),U,2)
106 S DGPFLOUT("CATEGORY")=$S(DGPFDA("FLAG")["26.11":"II (LOCAL)",DGPFDA("FLAG")["26.15":"I (NATIONAL)",1:"")
107 ;
108 S DGPFIEN=+$G(DGPFDA("STATUS"))
109 S DGPFLOUT("STATUS")=$$EXTERNAL^DILFD(26.13,.03,"F",DGPFIEN)
110 ;
111 ; set initial assignment
112 S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$G(DGPFHX("ASSIGNDT")),"5") ; AF
113 I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
114 . S DGPFIA=$$GETADT^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
115 . S DGPFLOUT("INITASSIGN")=$$FMTE^XLFDT(+$G(DGPFIA),"5")
116 ;
117 ; set last review date
118 S DGPFLOUT("LASTREVIEW")="N/A" ; AF action
119 I $G(DGPFLOUT("ASGMNTIEN"))]"" D ; EF and CO actions
120 . S DGPFLAST=$$GETLAST^DGPFAAH(DGPFLOUT("ASGMNTIEN"))
121 . S DGPFAHX=$$GETHIST^DGPFAAH(DGPFLAST,.DGPFAHX)
122 . Q:+$G(DGPFAHX("ASSIGNDT"))=+$G(DGPFIA) ; do not set if = init asgn
123 . S DGPFLOUT("LASTREVIEW")=$$FMTE^XLFDT(+$G(DGPFAHX("ASSIGNDT")),"5D")
124 ;
125 ; set next review date
126 S DGPFLOUT("REVIEWDT")="N/A"
127 I $G(DGPFDA("REVIEWDT"))]"" D
128 . S DGPFLOUT("REVIEWDT")=$$FMTE^XLFDT(+$G(DGPFDA("REVIEWDT")),"5D")
129 ;
130 S DGPFIEN=+$G(DGPFDA("OWNER"))_","
131 S DGPFLOUT("OWNER")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
132 ;
133 S DGPFIEN=+$G(DGPFDA("ORIGSITE"))_","
134 S DGPFLOUT("ORIGSITE")=$$GET1^DIQ(4,DGPFIEN,.01,"","","DGERR")
135 ;
136 S DGPFIEN=$G(DGPFHX("ACTION"))
137 S DGPFLOUT("ACTION")=$$EXTERNAL^DILFD(26.14,.03,"F",DGPFIEN)
138 ;
139 S DGPFLOUT("ACTIONDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
140 ;
141 S DGPFIEN=DUZ_","
142 S DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
143 ;
144 ; word processing fields
145 S DGPFIEN=+$G(DGPFHX("APPRVBY"))_","
146 S DGPFLOUT("APPRVBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
147 ;
148 M DGPFLOUT("NARR")=DGPFDA("NARR")
149 M DGPFLOUT("COMMENT")=DGPFHX("COMMENT")
150 ;
151 Q
152 ;
153BLDLOCFM(DGPFDA,DGPFHX,DGPFLOUT) ; build (L)ocal (OUT)put array
154 ;
155 ; This procedure builds a local array (DPGFLOUT) of all
156 ; FLAG MANAGEMENT fields to be presented to the user.
157 ;
158 ; Input:
159 ; DGPFDA - flag management data array
160 ; DGPFHX - flag management history array
161 ; DGPFLOUT - (L)ocal (OUT)put array
162 ;
163 ; Output:
164 ; DGPFLOUT - (L)ocal (OUT)put array
165 ;
166 ; Temporary variables:
167 N DGPFSUB ; loop control variable
168 ;
169 S DGPFLOUT("FLAGNAME")=$P($G(DGPFDA("FLAG")),U,2)
170 S DGPFLOUT("CATEGORY")="II (LOCAL)"
171 S DGPFLOUT("FLAGTYPE")=$P($G(DGPFDA("TYPE")),U,2)
172 S DGPFLOUT("STATUS")=$P($G(DGPFDA("STAT")),U,2)
173 S DGPFLOUT("REVFREQ")=$P(DGPFDA("REVFREQ"),U)
174 S DGPFLOUT("NOTIDAYS")=$P(DGPFDA("NOTIDAYS"),U)
175 S DGPFLOUT("REVGRP")=$P(DGPFDA("REVGRP"),U,2)
176 S DGPFLOUT("TIUTITLE")=$E($P(DGPFDA("TIUTITLE"),U,2),1,51)
177 S DGPFLOUT("ENTERDT")=$$FMTE^XLFDT($$NOW^XLFDT,"5T")
178 S DGPFIEN=DUZ_","
179 S DGPFLOUT("ENTERBY")=$$GET1^DIQ(200,DGPFIEN,.01,"","","DGERR")
180 ;
181 ; principal investigator(s)
182 S DGPFSUB=""
183 F S DGPFSUB=$O(DGPFDA("PRININV",DGPFSUB)) Q:DGPFSUB="" D
184 . Q:$G(DGPFDA("PRININV",DGPFSUB,0))="@"
185 . S DGPFLOUT("PRININV",DGPFSUB,0)=$P($G(DGPFDA("PRININV",DGPFSUB,0)),U,2)
186 ;
187 ; word processing fields
188 M DGPFLOUT("DESC")=DGPFDA("DESC")
189 M DGPFLOUT("REASON")=DGPFHX("REASON")
190 ;
191 Q
Note: See TracBrowser for help on using the repository browser.