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

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1VAFCMGB2 ;ALB/JRP-DEMOGRAPHIC MERGE SCREENS ;28-OCT-96
2 ;;5.3;Registration;**149,384,479**;Aug 13, 1993
3 ;
4 ;NOTE: This routine contains line tags used to build the display
5 ; screen for a List Manager interface. Refer to routine
6 ; VAFCMGB for a description of input/output variables.
7 ;
8GROUP3 ;Line tag to build logical group number three
9 ;
10 ;Group three contains the following fields:
11 ; .02, .05, .08, .211, .219, .2403, .31115
12 ;
13 ;Column width is limited to 28 characters
14 ;
15 ;Declare variables
16 N IENS,TARGET,MESSAGE,LINE,DATA,LOCAL,REMOTE,DIFF
17 S TARGET="^TMP(""VAFC-MERGE-TO"","_$J_",""DATA"")"
18 S MESSAGE="^TMP(""VAFC-MERGE-TO"","_$J_",""MESSAGE"")"
19 ;Initialize global locations
20 K @TARGET,@MESSAGE
21 ;Set group index
22 S @VALMAR@("GRP",3)=VALMCNT
23 ;Get local data for patient
24 D GETDATA^VAFCMGU0(VAFCDFN,3,TARGET,MESSAGE)
25 ;Build display
26 S IENS=VAFCDFN_","
27 ;Sex
28 S LOCAL=$$LOCAL^VAFCMGB0(2,.02,IENS,TARGET)
29 S REMOTE=$$REMOTE^VAFCMGB0(2,.02)
30 S DIFF=$$DIFFCHK^VAFCMGB0(2,.02,IENS,TARGET)
31 S LINE=$S(DIFF:"**",1:" ")_" 7" ;**479 12 to 7
32 S:DIFF&($P($G(@VAFCARR@(2,.02)),U,2)) LINE="->"_" 7" ;**479 12 to 7
33 S DATA="Sex: "_LOCAL
34 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,15)
35 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
36 S @VALMAR@("IDX",VALMCNT,7)="" ;**479 12 to 7
37 I (DIFF) D
38 .S @VALMAR@("E2F",7,1)="2^.02" ;**479 12 to 7
39 .S @VALMAR@("E2G",7)=3 ;**479 12 to 7
40 I ('DIFF) D
41 .K @VALMAR@("E2F",7) ;**479 12 to 7
42 .K @VALMAR@("E2G",7) ;**479 12 to 7
43 W:(+$G(VAFCDOTS)) "."
44 S VALMCNT=VALMCNT+1
45 ;Marital status
46 S LOCAL=$$LOCAL^VAFCMGB0(2,.05,IENS,TARGET)
47 S LOCAL=$E(LOCAL,1,28)
48 S REMOTE=$$REMOTE^VAFCMGB0(2,.05)
49 S REMOTE=$E(REMOTE,1,28)
50 S DIFF=$$DIFFCHK^VAFCMGB0(2,.05,IENS,TARGET)
51 S LINE=$S(DIFF:"**",1:" ")_" 8" ;**479 13 to 8
52 S:DIFF&($P($G(@VAFCARR@(2,.05)),U,2)) LINE="->"_" 8" ;**479 13 to 8
53 S DATA="Marital: "_LOCAL
54 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,11)
55 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
56 S @VALMAR@("IDX",VALMCNT,8)="" ;**479 13 to 8
57 I (DIFF) D
58 .S @VALMAR@("E2F",8,1)="2^.05" ;**479 13 to 8
59 .S @VALMAR@("E2G",8)=3 ;**479 13 to 8
60 I ('DIFF) D
61 .K @VALMAR@("E2F",8) ;**479 13 to 8
62 .K @VALMAR@("E2G",8) ;**479 13 to 8
63 W:(+$G(VAFCDOTS)) "."
64 S VALMCNT=VALMCNT+1
65 ;Religion
66 S LOCAL=$$LOCAL^VAFCMGB0(2,.08,IENS,TARGET)
67 S LOCAL=$E(LOCAL,1,28)
68 S REMOTE=$$REMOTE^VAFCMGB0(2,.08)
69 S REMOTE=$E(REMOTE,1,28)
70 S DIFF=$$DIFFCHK^VAFCMGB0(2,.08,IENS,TARGET)
71 S LINE=$S(DIFF:"**",1:" ")_" 9" ;**479 14 to 9
72 S:DIFF&($P($G(@VAFCARR@(2,.08)),U,2)) LINE="->"_" 9" ;**479 14 to 9
73 S DATA="Religion: "_LOCAL
74 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,10)
75 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
76 S @VALMAR@("IDX",VALMCNT,9)="" ;**479 14 to 9
77 I (DIFF) D
78 .S @VALMAR@("E2F",9,1)="2^.08" ;**479 14 to 9
79 .S @VALMAR@("E2G",9)=3 ;**479 14 to 9
80 I ('DIFF) D
81 .K @VALMAR@("E2F",9) ;**479 14 to 9
82 .K @VALMAR@("E2G",9) ;**479 14 to 9
83 W:(+$G(VAFCDOTS)) "."
84 S VALMCNT=VALMCNT+1
85 ;Mother's maiden name
86 S LOCAL=$$LOCAL^VAFCMGB0(2,.2403,IENS,TARGET)
87 S LOCAL=$E(LOCAL,1,28)
88 S REMOTE=$$REMOTE^VAFCMGB0(2,.2403)
89 S REMOTE=$E(REMOTE,1,28)
90 S DIFF=$$DIFFCHK^VAFCMGB0(2,.2403,IENS,TARGET)
91 S LINE=$S(DIFF:"**",1:" ")_"10" ;**479 15 to 10
92 S:DIFF&($P($G(@VAFCARR@(2,.2403)),U,2)) LINE="->"_"10" ;**479 15 to 10
93 S DATA="Mom's Maiden: "_LOCAL
94 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,6)
95 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
96 S @VALMAR@("IDX",VALMCNT,10)="" ;**479 15 to 10
97 I (DIFF) D
98 .S @VALMAR@("E2F",10,1)="2^.2403" ;**479 15 to 10
99 .S @VALMAR@("E2G",10)=3 ;**479 15 to 10
100 I ('DIFF) D
101 .K @VALMAR@("E2F",10) ;**479 15 to 10
102 .K @VALMAR@("E2G",10) ;**479 15 to 10
103 W:(+$G(VAFCDOTS)) "."
104 S VALMCNT=VALMCNT+1
105 ;Employment status
106 S LOCAL=$$LOCAL^VAFCMGB0(2,.31115,IENS,TARGET)
107 S LOCAL=$E(LOCAL,1,28)
108 S REMOTE=$$REMOTE^VAFCMGB0(2,.31115)
109 S REMOTE=$E(REMOTE,1,28)
110 S DIFF=$$DIFFCHK^VAFCMGB0(2,.31115,IENS,TARGET)
111 S LINE=$S(DIFF:"**",1:" ")_"11" ;**479 16 to 11
112 S:DIFF&($P($G(@VAFCARR@(2,.31115)),U,2)) LINE="->"_"11" ;**479 16 to 11
113 S DATA="Employ Stat: "_LOCAL
114 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,7)
115 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
116 S @VALMAR@("IDX",VALMCNT,11)="" ;**479 16 to 11
117 I (DIFF) D
118 .S @VALMAR@("E2F",11,1)="2^.31115" ;**479 16 to 11
119 .S @VALMAR@("E2G",11)=3 ;**479 16 to 11
120 I ('DIFF) D
121 .K @VALMAR@("E2F",11) ;**479 16 to 11
122 .K @VALMAR@("E2G",11) ;**479 16 to 11
123 W:(+$G(VAFCDOTS)) "."
124 S VALMCNT=VALMCNT+1
125 ;Next of kin's name
126 S LOCAL=$$LOCAL^VAFCMGB0(2,.211,IENS,TARGET)
127 S LOCAL=$E(LOCAL,1,28)
128 S REMOTE=$$REMOTE^VAFCMGB0(2,.211)
129 S REMOTE=$E(REMOTE,1,28)
130 S DIFF=$$DIFFCHK^VAFCMGB0(2,.211,IENS,TARGET)
131 S LINE=$S(DIFF:"**",1:" ")_"12" ;**479 17 to 12
132 S:DIFF&($P($G(@VAFCARR@(2,.211)),U,2)) LINE="->"_"12" ;**384 ;**479 17 to 12
133 S DATA="NOK Name: "_LOCAL
134 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,10)
135 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
136 S @VALMAR@("IDX",VALMCNT,12)="" ;**479 17 to 12
137 I (DIFF) D
138 .S @VALMAR@("E2F",12,1)="2^.211" ;**479 17 to 12
139 .S @VALMAR@("E2G",12)=3 ;**479 17 to 12
140 I ('DIFF) D
141 .K @VALMAR@("E2F",12) ;**479 17 to 12
142 .K @VALMAR@("E2G",12) ;**479 17 to 12
143 W:(+$G(VAFCDOTS)) "."
144 S VALMCNT=VALMCNT+1
145 ;Next of kin's phone number
146 S LOCAL=$$LOCAL^VAFCMGB0(2,.219,IENS,TARGET)
147 S LOCAL=$E(LOCAL,1,28)
148 S REMOTE=$$REMOTE^VAFCMGB0(2,.219)
149 S REMOTE=$E(REMOTE,1,28)
150 S DIFF=$$DIFFCHK^VAFCMGB0(2,.219,IENS,TARGET)
151 S LINE=$S(DIFF:"**",1:" ")_"13" ;**479 18 to 13
152 S:DIFF&($P($G(@VAFCARR@(2,.219)),U,2)) LINE="->"_"13" ;**384 ;**479 18 to 13
153 S DATA="NOK Phone #: "_LOCAL
154 S LINE=$$INSERT^VAFCMGU0(DATA,LINE,7)
155 S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
156 S @VALMAR@("IDX",VALMCNT,13)="" ;**479 18 to 13
157 I (DIFF) D
158 .S @VALMAR@("E2F",13,1)="2^.219" ;**479 18 to 13
159 .S @VALMAR@("E2G",13)=3 ;**479 18 to 13
160 I ('DIFF) D
161 .K @VALMAR@("E2F",13) ;**479 18 to 13
162 .K @VALMAR@("E2G",13) ;**479 18 to 13
163 W:(+$G(VAFCDOTS)) "."
164 S VALMCNT=VALMCNT+1
165 ;Done
166 K @TARGET,@MESSAGE
167 Q
Note: See TracBrowser for help on using the repository browser.