source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS30.m@ 1000

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1VAQDIS30 ;ALB/JFP,JRP - BUILDS DISPLAY ARRAY FOR (MAS DATA);3JUL91 [ 10/02/96 10:02 AM ]
2 ;;1.5;PATIENT DATA EXCHANGE;**13,22,40**;NOV 17, 1993
3SCR6 ;SCREEN 6 (SECOND HALF)
4R9 ;
5 S X=$$SETSTR^VALM1("A/O EXP: "_$G(@XTRCT@("VALUE",2,.32102,0)),"",9,16)
6 S VAQTMP=$G(@XTRCT@("VALUE",2,.32107,0)) D SCR6A
7 S X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,21)
8 S VAQTMP=$G(@XTRCT@("VALUE",2,.32109,0)) D SCR6A
9 S X=$$SETSTR^VALM1("Exam: "_VAQINF,X,44,17)
10 S X=$$SETSTR^VALM1("A/O #: "_$G(@XTRCT@("VALUE",2,.3211,0)),X,61,17)
11 D TMP
12R10 ;
13 S X=$$SETSTR^VALM1("ION Rad: "_$G(@XTRCT@("VALUE",2,.32103,0)),"",9,17)
14 S VAQTMP=$G(@XTRCT@("VALUE",2,.32111,0)) D SCR6A
15 S X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,16)
16 S X=$$SETSTR^VALM1("Method: "_$G(@XTRCT@("VALUE",2,.3212,0)),X,42,37)
17 D TMP
18R11 ;
19 S X=$$SETSTR^VALM1("Lebanon: "_$G(@XTRCT@("VALUE",2,.3221,0)),"",9,16)
20 S VAQTMP=$G(@XTRCT@("VALUE",2,.3222,0)) D SCR6A
21 S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
22 S VAQTMP=$G(@XTRCT@("VALUE",2,.3223,0)) D SCR6A
23 S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
24 D TMP
25R12 ;
26 S X=$$SETSTR^VALM1("Grenada: "_$G(@XTRCT@("VALUE",2,.3224,0)),"",9,16)
27 S VAQTMP=$G(@XTRCT@("VALUE",2,.3225,0)) D SCR6A
28 S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
29 S VAQTMP=$G(@XTRCT@("VALUE",2,.3226,0)) D SCR6A
30 S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
31 D TMP
32R13 ;
33 S X=$$SETSTR^VALM1("Panama: "_$G(@XTRCT@("VALUE",2,.3227,0)),"",10,15)
34 S VAQTMP=$G(@XTRCT@("VALUE",2,.3228,0)) D SCR6A
35 S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
36 S VAQTMP=$G(@XTRCT@("VALUE",2,.3229,0)) D SCR6A
37 S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
38 D TMP
39R14 ;
40 S X=$$SETSTR^VALM1("Gulf War: "_$G(@XTRCT@("VALUE",2,.32201,0)),"",8,17)
41 S VAQTMP=$G(@XTRCT@("VALUE",2,.322011,0)) D SCR6A
42 S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
43 S VAQTMP=$G(@XTRCT@("VALUE",2,.322012,0)) D SCR6A
44 S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
45 D TMP
46R15 ;
47 S X=$$SETSTR^VALM1("Somalia: "_$G(@XTRCT@("VALUE",2,.322016,0)),"",9,16)
48 S VAQTMP=$G(@XTRCT@("VALUE",2,.322017,0)) D SCR6A
49 S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
50 S VAQTMP=$G(@XTRCT@("VALUE",2,.322018,0)) D SCR6A
51 S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
52 D TMP
53R16 ;
54 S X=$$SETSTR^VALM1("Env Contam: "_$G(@XTRCT@("VALUE",2,.322013,0)),"",6,20)
55 S VAQTMP=$G(@XTRCT@("VALUE",2,.322014,0)) D SCR6A
56 S X=$$SETSTR^VALM1("Reg: "_VAQINF,X,26,18)
57 S VAQTMP=$G(@XTRCT@("VALUE",2,.322015,0)) D SCR6A
58 S X=$$SETSTR^VALM1("Exam: "_VAQINF,X,44,35)
59 D TMP
60R17 ;
61 S X=$$SETSTR^VALM1("Mil Disab: "_$G(@XTRCT@("VALUE",2,.362,0)),"",7,72)
62 D TMP
63R18 ;
64 ;D BLANK^VAQDIS20
65 S X=$$SETSTR^VALM1("Dent Inj: "_$G(@XTRCT@("VALUE",2,.368,0)),"",8,44)
66 S VAQTMP=$G(@XTRCT@("VALUE",2,.369,0))
67 S VAQINF=$S(VAQTMP'="":VAQTMP,1:"UNANSWERED")
68 S X=$$SETSTR^VALM1("Teeth Extracted: "_VAQINF,X,52,27)
69 D TMP
70R19 ;
71 ;DISPLAY DENTAL TREATMENT FROM LEAST RECENT TO MOST RECENT
72 S X=""
73 F S X=$O(@XTRCT@("VALUE",2.11,.01,X)) Q:(X="") D
74 .S VAQTMP=@XTRCT@("VALUE",2.11,.01,X)
75 .;Check when no dental treatment dates exist
76 .Q:(VAQTMP="")
77 .D SCR6A
78 .S VAQCHK(VAQTMP)=VAQINF_"^"_$G(@XTRCT@("VALUE",2.11,2,X))
79 S VAQCHK=""
80 F S VAQCHK=$O(VAQCHK(VAQCHK)) Q:(VAQCHK="") D
81 .S VAQTMP=VAQCHK(VAQCHK)
82 .S X=" Trt Date: "_$P(VAQTMP,"^",1)
83 .S X=$$SETSTR^VALM1("Cond.:",X,24,6)
84 .S VAQINF=$P(VAQTMP,"^",2)
85 .S VAQINF(1)=""
86 .F VAQTMP=1:1:$L(VAQINF," ") D
87 ..S VAQINF(2)=" "_$P(VAQINF," ",VAQTMP)
88 ..I ($L(VAQINF(2))>49) D
89 ...S $P(VAQINF," ",VAQTMP)=$E(VAQINF(2),50,$L(VAQINF(2)))
90 ...S VAQINF(2)=$E(VAQINF(2),1,49)
91 ...S VAQTMP=VAQTMP-1
92 ..I (($L(VAQINF(1))+$L(VAQINF(2)))>49) D
93 ...S X=$$SETSTR^VALM1(VAQINF(1),X,30,49)
94 ...D TMP
95 ...S (VAQINF(1),X)=""
96 ..S VAQINF(1)=VAQINF(1)_VAQINF(2)
97 .I (VAQINF(1)'="") D
98 ..S X=$$SETSTR^VALM1(VAQINF(1),X,30,49)
99 ..D TMP
100 K VAQCHK
101R20 ;
102 S X=$$SETSTR^VALM1("Yugoslavia: "_$G(@XTRCT@("VALUE",2,.322019,0)),"",6,19)
103 S VAQTMP=$G(@XTRCT@("VALUE",2,.32202,0)) D SCR6A
104 S X=$$SETSTR^VALM1("From: "_VAQINF,X,25,21)
105 S VAQTMP=$G(@XTRCT@("VALUE",2,.322021,0)) D SCR6A
106 S X=$$SETSTR^VALM1("To: "_VAQINF,X,46,33)
107 D TMP
108R21 ;
109 S VAQTMP=$G(@XTRCT@("VALUE",2,.531,0))
110 S X=$$SETSTR^VALM1("Purple Heart: "_VAQTMP,"",4,27)
111 I $E(VAQTMP)="Y" D
112 . S VAQTMP=$G(@XTRCT@("VALUE",2,.532,0)) Q:VAQTMP']""
113 . S X=$$SETSTR^VALM1("PH Status: "_VAQTMP,X,31,48)
114 E I $E(VAQTMP)="N" D
115 . S VAQTMP=$G(@XTRCT@("VALUE",2,.533,0)) Q:VAQTMP']""
116 . S X=$$SETSTR^VALM1("PH Remarks: "_VAQTMP,X,31,48)
117 D TMP
118EXIT K VAQTMP,VAQINF
119 QUIT
120 ;
121TMP ; -- Sets up display array
122 S VALMCNT=VALMCNT+1
123 S @ROOT@(VALMCNT,0)=$E(X,1,79)
124 QUIT
125 ;
126SCR6A ; -- External date to internal date
127 I VAQTMP="" S VAQINF="" QUIT
128 S VAQTMP=$$DATE^VAQUTL99(VAQTMP)
129 S VAQINF=$S(VAQTMP'="":$E(VAQTMP,4,5)_"/"_$E(VAQTMP,6,7)_"/"_$E(VAQTMP,2,3),1:VAQTMP)
130 QUIT
131 ;
132SCR6B I VAQINF["OTHER THAN" S VAQINF="OTHER"
133 S VAQINF=$E(VAQINF,1,12)
134 QUIT
Note: See TracBrowser for help on using the repository browser.