source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIM3.m@ 623

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1VAQDBIM3 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 3);4-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3 ; **********
4 ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
5 ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
6 ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
7 ; **********
8 ;
9XTRCT3(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 3
10 ;DEDUCTABLE EXPENSES INFORMATION
11 ;This module is based on DIS^DGMTSC3
12 ;
13 ;INPUT : See EXTRACT^VAQDBIM for explanation of parameters. Input
14 ; also includes all DG* variables required to build screen.
15 ;OUTPUT : n - Number of lines in display
16 ; -1^Error_text - Error
17 ;
18 ;CHECK INPUT
19 Q:('$D(DFN)) "-1^Pointer to patient file not passed"
20 Q:('$D(ARRAY)) "-1^Reference to output array not passed"
21 Q:('$D(OFFSET)) "-1^Starting offset not passed"
22 ;DECLARE VARIABLES
23 N DGDC,DGCNT,DGDCS,DGDEP,DGIN1,DGINC,DGINR,DGREL,DGVIR0,TMP,LINES
24 N COUNT,CHILD
25 ;EXTRACT HEADER
26 S LINES=OFFSET
27 S TMP=$$HEADER^VAQDBIM0(3,ARRAY,OFFSET)
28 Q:(TMP<0) TMP
29 S OFFSET=LINES+TMP
30 ;INITIALIZE MEANS TEST VARIABLES
31 S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)),DGIN1("V")=$G(^DGMT(408.21,DGVINI,1))
32 S DGDC=$P(DGVIR0,"^",8) I DGDC D SET^DGMTSC31 S:'$D(DGDCS) DGDC=0
33 S TMP=$$INSERT^VAQUTL1("Medical Expenses: ","",19)_$$AMT^DGMTSCU1($P(DGIN1("V"),"^"))
34 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
35 S OFFSET=OFFSET+1
36 S TMP=$$INSERT^VAQUTL1("Funeral and Burial Expenses: ","",8)_$S('$P(DGVIR0,"^",5)&('$P(DGVIR0,"^",8)):"N/A",1:$$AMT^DGMTSCU1($P(DGIN1("V"),"^",2)))
37 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
38 S OFFSET=OFFSET+1
39 S TMP=$$INSERT^VAQUTL1("Veteran's Educational Expenses: ","",5)_$$AMT^DGMTSCU1($P(DGIN1("V"),"^",3))
40 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
41 S OFFSET=OFFSET+1
42 S @ARRAY@("DISPLAY",OFFSET,0)=""
43 S OFFSET=OFFSET+1
44 S TMP=$$INSERT^VAQUTL1("Child's Education Expenses: ","",5)_$S('DGDC:"N/A",1:"")
45 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
46 S OFFSET=OFFSET+1
47 ;EXTRACT DEPENDENT CHILDREN WITH EMPLOYMENT INCOME
48 I DGDC D
49 .;SET COLUMN HEADINGS
50 .S @ARRAY@("DISPLAY",OFFSET,0)=""
51 .S OFFSET=OFFSET+1
52 .S TMP=$$INSERT^VAQUTL1("Child's","",9)
53 .S TMP=$$INSERT^VAQUTL1("Employment",TMP,25)
54 .S TMP=$$INSERT^VAQUTL1("Post-secondary",TMP,37)
55 .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
56 .S OFFSET=OFFSET+1
57 .S TMP=$$INSERT^VAQUTL1("First Name","",9)
58 .S TMP=$$INSERT^VAQUTL1("Income",TMP,25)
59 .S TMP=$$INSERT^VAQUTL1("Education Expenses",TMP,36)
60 .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
61 .S OFFSET=OFFSET+1
62 .S TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",12),"",9)
63 .S TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",10),TMP,25)
64 .S TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",18),TMP,37)
65 .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
66 .S OFFSET=OFFSET+1
67 .;EXTRACT INFO FOR EACH DEPENDENT CHILD
68 .S COUNT=0 F S COUNT=$O(DGDCS(COUNT)) Q:'COUNT S CHILD=DGDCS(COUNT) D CHILD
69 Q (OFFSET-LINES)
70 ;
71CHILD ;EXTRACT EMPLOYMENT INCOME AND EXPENSES FOR A DEPENDENT CHILD
72 ;This module is based on CHILD^DGMTSC31
73 N DGIN0,DGIN1,TMP,Y
74 S DGIN0=$G(^DGMT(408.21,+$G(DGINC("C",CHILD)),0)),DGIN1=$G(^(1))
75 S TMP=$$INSERT^VAQUTL1((COUNT_"."),"",5)
76 S Y=$E($P($$NAME^DGMTU1(+DGREL("C",CHILD)),",",2),1,12)
77 S TMP=$$INSERT^VAQUTL1(Y,TMP,9)
78 S Y=$J($$AMT^DGMTSCU1($P(DGIN0,"^",14)),10)
79 S TMP=$$INSERT^VAQUTL1(Y,TMP,25)
80 S Y=$J($S(($P(DGIN0,"^",14)-$P(DGMTPAR,"^",17))>0:$$AMT^DGMTSCU1($P(DGIN1,"^",3)),1:"N/A"),10)
81 S TMP=$$INSERT^VAQUTL1(Y,TMP,45)
82 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
83 S OFFSET=OFFSET+1
84 Q
Note: See TracBrowser for help on using the repository browser.