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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1VAFCMGU0 ;ALB/JRP-MERGE SCREEN UTILITIES ;10/18/96
2 ;;5.3;Registration;**149,295,479**;Aug 13, 1993
3 ;
4REPEAT(CHAR,TIMES) ;Repeat a string
5 ;
6 ;INPUT : CHAR - Character to repeat
7 ; TIMES - Number of times to repeat CHAR
8 ;OUTPUT : s - String of CHAR that is TIMES long
9 ; "" - Error (bad input)
10 ;
11 ;Check input
12 Q:($G(CHAR)="") ""
13 Q:((+$G(TIMES))=0) ""
14 ;Return string
15 Q $TR($J("",TIMES)," ",CHAR)
16 ;
17INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;Insert a string into another
18 ;
19 ;INPUT : INSTR - String to insert
20 ; OUTSTR - String to insert into
21 ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
22 ; LENGTH - Number of characters to clear from OUTSTR
23 ; (defaults to length of INSTR)
24 ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
25 ; using LENGTH characters
26 ; "" - Error (bad input)
27 ;
28 ;NOTE : This module is based on $$SETSTR^VALM1
29 ;
30 ;Check input
31 Q:('$D(INSTR)) ""
32 Q:('$D(OUTSTR)) ""
33 S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
34 S:('$D(LENGTH)) LENGTH=$L(INSTR)
35 ;Declare variables
36 N FRONT,END
37 ;Get front portion of new string
38 S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
39 ;Get ending portion of new string
40 S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
41 ;Insert string
42 Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
43 ;
44CENTER(CNTRSTR,MARGIN) ;Center a string
45 ;
46 ;INPUT : CNTRSTR - String to center
47 ; MARGIN - Margin width to center within (defaults to 80)
48 ;OUTPUT : s - INSTR will be centered in a margin width of MARGIN
49 ; "" - Error (bad input)
50 ;NOTES : A margin width of 80 will be used when MARGIN<1
51 ; : CNTRSTR will be returned when $L(CNTRSTR)>MARGIN
52 ;
53 ;Check input
54 Q:($G(CNTRSTR)="") ""
55 S:($G(MARGIN)<1) MARGIN=80
56 ;Center the string
57 Q $$INSERT(CNTRSTR,"",((MARGIN\2)-($L(CNTRSTR)\2)))
58 ;
59IN2EXDT(DATE,STYLE) ;Converts dates from internal to external format
60 ;
61 ;Input : DATE - Date in FileMan format
62 ; STYLE - Flag indicating output style
63 ; If 0, return date in format MM-DD-YYYY (Default)
64 ; If 1, return date in format MMM DD, YYYY
65 ; (MMM -> first three characters of month)
66 ;Output : External date in specified format
67 ;Notes : Time will NOT be included, even if present on input
68 ; : NULL ("") is returned on bad input
69 ;
70 ;Check input
71 S DATE=+$P($G(DATE),".",1)
72 Q:('DATE) ""
73 Q:(DATE'?7N) ""
74 S STYLE=+$G(STYLE)
75 ;Return date in MM-DD-YYYY format
76 Q:('STYLE) $E(DATE,4,5)_"-"_$E(DATE,6,7)_"-"_($E(DATE,1,3)+1700)
77 ;Declare variables
78 N Y,%DT
79 ;Return date in MMM DD, YYYY format
80 S Y=DATE
81 D DD^%DT
82 Q Y
83 ;
84EX2INDT(DATE) ;Converts dates from external to internal format
85 ;
86 ;Input : Date in external format
87 ;Output : Date in FileMan format
88 ;Notes : Time will be included if present on input
89 ; : NULL ("") is returned on bad input
90 ;
91 ;Check input
92 S DATE=$G(DATE)
93 Q:(DATE="") ""
94 ;Declare variables
95 N X,%DT,Y
96 ;Convert date
97 S DATE=$P(DATE,"@",1) ;**295 strip time off
98 I $L(DATE,"/")=3,'$P(DATE,"/",2) S DATE=$P(DATE,"/",1)_"/"_$P(DATE,"/",3) ;**295 imprecise date - ##/00/#### to ##/####
99 I $L(DATE,"/")=2,'$P(DATE,"/",1) S DATE=$P(DATE,"/",2) ;**295 imprecise date - 00/#### to ####
100 S X=DATE
101 S %DT="TS"
102 D ^%DT
103 Q:(Y=-1) ""
104 Q Y
105 ;
106NOW(FMFORM,NOTIME) ;Returns current date/time
107 ;
108 ;Input : FMFORM - Flag indicating if FileMan format should be used
109 ; If 0, return in the format MM-DD-YYYY@HH:MM:SS
110 ; (default)
111 ; If 1, return in FileMan format
112 ; NOTIME - Flag indicating if time should not be included
113 ; If 0, time will be included in output (default)
114 ; If 1, time will not be included in output
115 ;Output : Current date & time in specified format
116 ;
117 ;Check input
118 S FMFORM=+$G(FMFORM)
119 S NOTIME=+$G(NOTIME)
120 ;Declare variables
121 N X,%,%H,%I,OUT
122 ;Get current date/time
123 D NOW^%DTC
124 ;Return date/time in FileMan format
125 Q:(FMFORM) $S(NOTIME:X,1:%)
126 ;Return date/time in MM-DD-YYYY@HH:MM:SS format
127 S %=%_"000000"
128 S OUT=$E(%,4,5)_"-"_$E(%,6,7)_"-"_(1700+$E(%,1,3))
129 S:('NOTIME) OUT=OUT_"@"_$E(%,9,10)_":"_$E(%,11,12)_":"_$E(%,13,14)
130 Q OUT
131 ;
132GETDATA(DFN,GROUP,TARGET,MESSAGE) ;Get local data required to build
133 ; merge screens for a given patient
134 ;
135 ;Input : DFN - Pointer to entry in PATIENT file (#2)
136 ; GROUP - Group number to get data for (defaults to 1)
137 ; Group 1 = Name, SSN, date of birth & date of death
138 ; TARGET - Array to store data in (full global reference)
139 ; Defaults to ^TMP("VAFC-MERGE-TO",$J,"DATA")
140 ; MESSAGE - Array to store error data in (full global reference)
141 ; Defaults to ^TMP("VAFC-MERGE-TO",$J,"MESSAGE")
142 ;Output : None
143 ; TARGET & MESSAGE will be in the format defined by FileMan
144 ; for interaction with the Database Server calls. Refer to
145 ; the FileMan documentation on GETS^DIQ() for further
146 ; information.
147 ;Notes : All data will be in external format
148 ; : Groups 1 - 4 are currently supported
149 ; : Initialization of TARGET & MESSAGE is defined by the call
150 ; to GETS^DIQ(). Refer to the FileMan documentation for
151 ; further details.
152 ;
153 ;Check input
154 S DFN=+$G(DFN)
155 S GROUP=+$G(GROUP)
156 S:((GROUP<1)!(GROUP>4)) GROUP=0
157 S TARGET=$G(TARGET)
158 S:(TARGET="") TARGET="^TMP(""VAFC-MERGE-TO"","_$J_",""DATA"")"
159 S MESSAGE=$G(MESSAGE)
160 S:(MESSAGE="") MESSAGE="^TMP(""VAFC-MERGE-TO"","_$J_",""MESSAGE"")"
161 ;Declare variables
162 N IENS,FIELDS ;,COUNTY ;**479
163 S IENS=DFN_","
164 ;S COUNTY=0 ;**479
165 ;Group 1
166 S FIELDS=".01;.03;.09;.351"
167 ;Group 2
168 I (GROUP=2) D
169 .S FIELDS=".131;.132" ;".111;.1112;.112;.113;.114;.115;.117;.131;.132" ;**479
170 .;Remember that COUNTY (field #.117) was retrieved
171 .;S COUNTY=1 ;**479
172 ;Group 3
173 I (GROUP=3) D
174 .S FIELDS=".02;.05;.08;.211;.219;.2403;.31115"
175 ;Group 4
176 I (GROUP=4) D
177 .S FIELDS=".301;.302;.323;.361;.3612;.3615;.3616;391;1901"
178 ;Extract data
179 D GETS^DIQ(2,IENS,FIELDS,"",TARGET,MESSAGE)
180 ;Accomodate for incorrect extraction of COUNTY (field #.117)
181 ;S:(COUNTY) @TARGET@(2,IENS,.117)=$$COUNTY(DFN) ;**479
182 ;Done
183 Q
184 ;
185COUNTY(DFN) ;Return county name that patient lives in
186 ;
187 ;Input : DFN - Pointer to entry in PATIENT file (#2)
188 ;Output : County - Name of county that patient lives in
189 ;Notes : NULL is returned on error, bad input, and no county found
190 ;
191 ;Check input
192 S DFN=+$G(DFN)
193 ;Declare variables
194 N IENS,PTRCNTY,PTRSTATE,TMP
195 ;Get pointers to STATE file and COUNTY sub-file
196 S IENS=DFN_","
197 D GETS^DIQ(2,IENS,".115;.117","I","TMP","TMP")
198 S PTRSTATE=+$G(TMP(2,IENS,.115,"I"))
199 S PTRCNTY=+$G(TMP(2,IENS,.117,"I"))
200 Q:(('PTRSTATE)!('PTRCNTY)) ""
201 ;Get county name
202 S IENS=PTRCNTY_","_PTRSTATE_","
203 D GETS^DIQ(5.01,IENS,".01","","TMP","TMP")
204 ;Return county name
205 Q $G(TMP(5.01,IENS,.01))
Note: See TracBrowser for help on using the repository browser.