source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDIS21.m@ 1489

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1VAQDIS21 ;ALB/JFP - PDX, BUILDS DISPLAY ARRAY FOR MINIMAL DATA ;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
3DISPMIN(XTRCT,SEGPTR,ROOT,OFFSET,DSP) ;SAMPLE DISPLAY METHOD
4 ;INPUT : XTRCT - Input array (full global reference)
5 ; SEGPTR - Segment to extract (ptr to file #394.71)
6 ; ROOT - Output array (full global reference)
7 ; OFFSET - Starting line for display
8 ; DSP - Flag to set display option (1-on,0-off)
9 ;OUTPUT: n - Number of lines added to display
10 ; -1^ErrorText - Error
11 ;
12 ; -- Check input
13 Q:('$D(XTRCT)) "-1^Input array not passed on input"
14 Q:('$D(SEGPTR)) "-1^Segment not passed on input"
15 Q:('$D(ROOT)) "-1^Output array not passed on input"
16 Q:('$D(OFFSET)) "-1^Starting line for display not passed on input"
17 ;
18 S:('$D(DSP)) DSP=1
19 ; -- Declare variables
20 N X,SEGMENT,VAQPTAGE,VAQCNTY,STDA,CTDA,VAQST,VALMCNT,SSN
21 N COUNTY,CNTYNUM,CNTYINFO
22 ;
23 S VAQSEGND=$G(^VAT(394.71,SEGPTR,0))
24 Q:($P(VAQSEGND,U,2)="") "-1^Invalid segment"
25 S VALMCNT=$S(DSP=1:OFFSET-1,1:0)
26 I DSP=1 S ROOT=$$ROOT^VAQDIS20(ROOT)
27 I DSP=0 G ROW1
28 ;
29 ; -- Build display segment
30ROW0 ; -- Header line for display, only
31 S VAQLN=$$REPEAT^VAQUTL1("-",79)
32 S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment Description Missing")_" >"
33 S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK
34 K VAQLN,VAQCTR,VAQSEGND
35 ;
36ROW1 S X=$$SETSTR^VALM1("PAT Name: "_$G(@XTRCT@("VALUE",2,.01,0)),"",1,40)
37 S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,43,22)
38 S VAQPTAGE=$S($G(@XTRCT@("VALUE",2,.03,0))'="":$$AGE^VAQUTL99($$DATE^VAQUTL99($G(@XTRCT@("VALUE",2,.03,0)))),1:" ")
39 S X=$$SETSTR^VALM1("AGE: "_VAQPTAGE,X,64,14)
40 D TMP K VAQPTAGE
41 ;
42ROW2 S X=$$SETSTR^VALM1(" Addr: "_$G(@XTRCT@("VALUE",2,.111,0)),"",1,40)
43 S SSN=$$DASHSSN^VAQUTL99($G(@XTRCT@("VALUE",2,.09,0)))
44 S X=$$SETSTR^VALM1("SSN: "_SSN,X,43,16)
45 D TMP
46 ;
47ROW3 S X=$$SETSTR^VALM1(" : "_$G(@XTRCT@("VALUE",2,.112,0)),"",1,40)
48 S X=$$SETSTR^VALM1("Sex: "_$G(@XTRCT@("VALUE",2,.02,0)),X,43,12)
49 S X=$$SETSTR^VALM1("MS: "_$G(@XTRCT@("VALUE",2,.05,0)),X,65,14)
50 D TMP
51 ;
52ROW4 S X=$$SETSTR^VALM1(" : "_$G(@XTRCT@("VALUE",2,.113,0)),"",1,40)
53 S X=$$SETSTR^VALM1("Religion: "_$G(@XTRCT@("VALUE",2,.08,0)),X,43,30)
54 D TMP
55 ;
56ROW5 S STDA="",ST=$G(@XTRCT@("VALUE",2,.115,0))
57 S:ST'="" STDA=$O(^DIC(5,"B",$G(@XTRCT@("VALUE",2,.115,0)),STDA))
58 S VAQST=$S(STDA'="":$P(^DIC(5,STDA,0),U,2),1:" ")
59 S CTDA="",CT=$G(@XTRCT@("VALUE",2,.117,0))
60 I (CT'="")&(STDA'="") S CTDA=$O(^DIC(5,STDA,1,"C",$G(@XTRCT@("VALUE",2,.117,0)),CTDA))
61 S X=$$SETSTR^VALM1("City/ST: "_$G(@XTRCT@("VALUE",2,.114,0))_$S(ST="":" ",1:", ")_VAQST,"",2,39)
62 D TMP K STDA,ST,VAQST,CTDA,CT
63 ;
64ROW6 S X=$$SETSTR^VALM1("Zip: "_$G(@XTRCT@("VALUE",2,.1112,0)),"",6,15)
65 S X=$$SETSTR^VALM1("County: ",X,43,8)
66 S CNTYNUM=$G(@XTRCT@("VALUE",2,.117,0))
67 S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)),CNTYNUM)
68 S CNTYINFO=COUNTY_" ("_CNTYNUM_")"
69 S:(COUNTY="") CNTYINFO="UNKNOWN ("_CNTYNUM_")"
70 S:((COUNTY="")&(CNTYNUM="")) CNTYINFO="UNANSWERED"
71 S X=X_CNTYINFO
72 D TMP
73 ;
74ROW7 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
75ROW8 S X=$$SETSTR^VALM1(" Patient Type: "_$G(@XTRCT@("VALUE",2,391,0)),"",1,40)
76 S X=$$SETSTR^VALM1("Veteran: "_$G(@XTRCT@("VALUE",2,1901,0)),X,43,13) D TMP
77ROW9 S X=$$SETSTR^VALM1("Period of Service: "_$G(@XTRCT@("VALUE",2,.323,0)),"",1,40) D TMP
78ROW10 S X=$$SETSTR^VALM1("Service Connected: "_$G(@XTRCT@("VALUE",2,.301,0)),"",1,40)
79 S X=$$SETSTR^VALM1("Percentage: "_$G(@XTRCT@("VALUE",2,.302,0))_"%",X,43,36) D TMP
80ROW11 S X=$$SETSTR^VALM1(" Eligibility: "_$G(@XTRCT@("VALUE",2,.361,0)),"",1,40) D TMP,BLANK
81 D BLANK
82 ; -- Sets number of lines in display
83 QUIT VALMCNT-OFFSET
84 ;
85BLANK ; -- Sets up blank line
86 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
87 QUIT
88 ;
89TMP ; -- Sets up display array
90 S VALMCNT=VALMCNT+1
91 S @ROOT@(VALMCNT,0)=$E(X,1,79)
92 QUIT
93 ;
94END ; -- End of code
95 QUIT
Note: See TracBrowser for help on using the repository browser.