source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS23.m@ 956

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1VAQDIS23 ;ALB/JFP,JRP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
3 ;
4SCR1 ; -- Builds MAS DATA SCREEN 1, DEMOGRAPHICS
5ROW0 ; -- Header line for display
6 S VAQLN=$$REPEAT^VAQUTL1("-",79)
7 S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
8 S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK^VAQDIS20
9 I $G(@XTRCT@("VALUE",2,.152,0))'="" D
10 .S X=$$SETSTR^VALM1("* Applicant is listed as (INELIGIBLE) for treatment","",1,79)
11 .D TMP
12 I $G(@XTRCT@("VALUE",2,.153,0))'="" D
13 .S X=$$SETSTR^VALM1("* Applicant is listed as (MISSING). NOTIFY APPROPRIATE PERSONNEL","",1,79)
14 .D TMP
15 D BLANK^VAQDIS20
16 S VAQLN=$$REPEAT^VAQUTL1(" ",79)
17 S VAQCTR=" -- PATIENT DEMOGRAPHICS -- "
18 S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK^VAQDIS20
19 K VAQLN,VAQCTR
20ROW1 ;
21 S X=$$SETSTR^VALM1("Name: "_$G(@XTRCT@("VALUE",2,.01,0)),"",8,44)
22 S SSN=$$DASHSSN^VAQUTL99($G(@XTRCT@("VALUE",2,.09,0)))
23 S X=$$SETSTR^VALM1("SSN: "_SSN,X,45,16)
24 S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,62,17)
25 D TMP K SSN
26ROW2 ;
27 S SEQ=""
28 F J=1:1 S SEQ=$O(@XTRCT@("VALUE",2.01,.01,SEQ)) Q:SEQ="" D
29 .S:J=1 X=$$SETSTR^VALM1("Alias: "_$G(@XTRCT@("VALUE",2.01,.01,SEQ)),"",7,49)
30 .S:J'=1 X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2.01,.01,SEQ)),"",14,49)
31 .S VAQASSN=$G(@XTRCT@("VALUE",2.01,1,SEQ))
32 .S:VAQASSN'="" VAQASSN=$$DASHSSN^VAQUTL99(VAQASSN)
33 .S X=$$SETSTR^VALM1(VAQASSN,X,50,29)
34 .D TMP
35 K J,SEQ,VAQASSN
36ROW3 ;
37 S VAQTMP=$G(@XTRCT@("VALUE",2,.091,0))
38 S VAQINF=$S(VAQTMP="":"No remarks entered for this patient",1:VAQTMP)
39 S X=$$SETSTR^VALM1("Remark: "_VAQINF,"",5,79)
40 D TMP
41 K VAQTMP,VAQINF
42ROW4 ;
43 S X=$$SETSTR^VALM1("Permanent Address:","",5,44)
44 S X=$$SETSTR^VALM1("Temporary Address:",X,45,34)
45 D TMP
46 ;
47PRMADD ; -- Permanent Address
48 K ADDR
49 S VAQTMP=1
50 F VAQX=.111,.112,.113 D Q:(VAQINF="")
51 .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
52 .I ((VAQX=.111)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
53 .Q:(VAQINF="")
54 .S ADDR(VAQTMP)=VAQINF
55 .S VAQTMP=VAQTMP+1
56 S CTY=$G(@XTRCT@("VALUE",2,.114,0))
57 S ZIP=$G(@XTRCT@("VALUE",2,.1112,0))
58 S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)))
59 S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
60 S ADDR(VAQTMP)=VAQINF
61TMPADD ;Temporary address
62 K ADDRT
63 S VAQTMP=1
64 F VAQX=.1211,.1212,.1213 D Q:(VAQINF="")
65 .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
66 .I ((VAQX=.1211)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
67 .Q:(VAQINF="")
68 .S ADDRT(VAQTMP)=VAQINF
69 .S VAQTMP=VAQTMP+1
70 S CTY=$G(@XTRCT@("VALUE",2,.1214,0))
71 S ZIP=$G(@XTRCT@("VALUE",2,.12112,0))
72 S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.1215,0)))
73 S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
74 S ADDRT(VAQTMP)=VAQINF
75 D ADRLOAD
76 K ADDR,ADDRT,VAQTMP,VAQINF,VAQX,CTY,STATE,ZIP
77 ;
78ROW9 ; -- County
79 S CTYNUM=$G(@XTRCT@("VALUE",2,.117,0))
80 S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)),CTYNUM)
81 S VAQINF=COUNTY_" ("_CTYNUM_")"
82 S:(COUNTY="") VAQINF="UNKNOWN ("_CTYNUM_")"
83 S:((COUNTY="")&(CTYNUM="")) VAQINF="UNANSWERED"
84 S X=$$SETSTR^VALM1("County: "_VAQINF,"",2,43)
85 S CTYNUM=$G(@XTRCT@("VALUE",2,.12111,0))
86 S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.1215,0)),CTYNUM)
87 S VAQINF=COUNTY_" ("_CTYNUM_")"
88 S:(COUNTY="") VAQINF="UNKNOWN ("_CTYNUM_")"
89 S:((COUNTY="")&(CTYNUM="")) VAQINF="UNANSWERED"
90 S X=$$SETSTR^VALM1("County: "_VAQINF,X,44,35)
91 D TMP
92 K CTYNUM,COUNTY,VAQINF
93ROW10 ; -- Phone
94 S X=$$SETSTR^VALM1("Phone: "_$G(@XTRCT@("VALUE",2,.131,0)),"",3,43)
95 S TPHONE=$G(@XTRCT@("VALUE",2,.1219,0))
96 S X=$$SETSTR^VALM1("Phone: "_$S(TPHONE'="":TPHONE,1:"NOT APPLICABLE"),X,45,34)
97 D TMP K TPHONE
98ROW11 ; -- Work phone/temporary form-to
99 S X=$$SETSTR^VALM1("Office: "_$G(@XTRCT@("VALUE",2,.132,0)),"",2,43)
100 S VAQFROM=$G(@XTRCT@("VALUE",2,.1217,0))
101 S VAQTO=$G(@XTRCT@("VALUE",2,.1218,0))
102 S VAQFROMT=VAQFROM_"-"_VAQTO
103 I VAQFROMT="-" S VAQFROMT="NOT APPLICABLE"
104 S X=$$SETSTR^VALM1("From/To: "_VAQFROMT,X,43,36)
105 K VAQFROM,VAQTO,VAQFROMT
106 D TMP
107EXIT ;
108 QUIT
109 ;
110ADRLOAD ; -- Loads addresses into display array
111 F VAQX=1:1:4 D
112 .S VAQINF=""
113 .S:($D(ADDR(VAQX))) VAQINF=$$SETSTR^VALM1(ADDR(VAQX),VAQINF,15,53)
114 .S:($D(ADDRT(VAQX))) VAQINF=$$SETSTR^VALM1(ADDRT(VAQX),VAQINF,54,25)
115 .Q:(VAQINF="")
116 .S VALMCNT=VALMCNT+1
117 .S @ROOT@(VALMCNT,0)=$E(VAQINF,1,79)
118 Q
119 ;
120TMP ; -- Sets up display array
121 S VALMCNT=VALMCNT+1
122 S @ROOT@(VALMCNT,0)=$E(X,1,79)
123 QUIT
124 ;
125END ; -- End of code
126 QUIT
Note: See TracBrowser for help on using the repository browser.