source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIM4.m@ 1096

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1VAQDBIM4 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 4);5-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;**38**;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 ;
9XTRCT4(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 1
10 ;PREVIOUS CALENDAR YEAR NET WORTH
11 ;This module is based on DIS^DGMTSC4
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 DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC
24 N DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,TMP,LINES,Y
25 ;INITIALIZE MEANS TEST VARIABLES
26 D SET^DGMTSCU2
27 ;EXTRACT HEADER
28 S LINES=OFFSET
29 S TMP=$$HEADER^VAQDBIM0(4,ARRAY,OFFSET)
30 Q:(TMP<0) TMP
31 S OFFSET=LINES+TMP
32 ;SET COLUMN HEADINGS
33 S TMP="Income Thresholds: "
34 I $D(DGTHA) D
35 .S Y="Category A: "_$$AMT^DGMTSCU1(DGTHA)
36 .S TMP=$$INSERT^VAQUTL1(Y,TMP)
37 I $D(DGTHB) D
38 .S Y="Category B: "_$$AMT^DGMTSCU1(DGTHB)
39 .S TMP=$$INSERT^VAQUTL1(Y,TMP,56)
40 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
41 S OFFSET=OFFSET+1
42 S TMP=""
43 S:$D(DGMTPAR("PREV")) TMP="*Previous Years Thresholds*"
44 S TMP=$$INSERT^VAQUTL1("Veteran",TMP,35)
45 S:DGSP TMP=$$INSERT^VAQUTL1("Spouse",TMP,47)
46 S TMP=$$INSERT^VAQUTL1("Total",TMP,74)
47 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
48 S OFFSET=OFFSET+1
49 S TMP=$$REPEAT^VAQUTL1("-",47)
50 S TMP=$$INSERT^VAQUTL1(TMP,"",32)
51 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
52 S OFFSET=OFFSET+1
53 D FLD(1,"Cash, Amts in Bank Accts")
54 D FLD(2,"Stocks and Bonds")
55 D FLD(3,"Real Property")
56 D FLD(4,"Other Property or Assets")
57 D FLD(5,"Debts")
58 S TMP=$$INSERT^VAQUTL1("Total -->","",52)
59 S Y=$J($$AMT^DGMTSCU1(DGNWT),12)
60 S TMP=$$INSERT^VAQUTL1(Y,TMP,67)
61 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
62 S OFFSET=OFFSET+1
63 F TMP=1:1:7 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
64 I $P($G(^DGMT(408.31,DGMTI,0)),U,14) S TMP="Declines to give income information makes a Category C."
65 E D
66 . S TMP="Income of "_$J($$AMT^DGMTSCU1(DGINT-DGDET),12)_" Category "_DGCAT
67 . I DGTYC="M",(DGNWT+DGINT-DGDET)>$P(DGMTPAR,"^",8) S TMP=TMP_" property of "_$J($$AMT^DGMTSCU1(DGNWT),12)_" makes a Category C."
68 . I DGTYC="M",'DGNWTF S TMP=TMP_" requires property information."
69 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
70 S OFFSET=OFFSET+1
71 Q (OFFSET-LINES)
72 ;
73FLD(PIECE,LABEL) ;EXTRACT NET WORTH FIELDS
74 ;INPUT : PIECE - Piece position in DGIN2 to extract
75 ; LABEL - Label to use (income description)
76 ; Input also includes:
77 ; all DG* variables
78 ; ARRAY
79 ; OFFSET
80 ;
81 ;This module is based on FLD^DGMTSC4
82 ;
83 ;DECLARE VARIABLES
84 N TOTAL,I,TMP,Y
85 ;EXTRACT INFO
86 S TMP=$$INSERT^VAQUTL1(LABEL,"",5)
87 S Y=$J($$AMT^DGMTSCU1($P(DGIN2("V"),"^",PIECE)),10)
88 S TMP=$$INSERT^VAQUTL1(Y,TMP,32)
89 I $D(DGIN2("S")) D
90 .S Y=$J($$AMT^DGMTSCU1($P(DGIN2("S"),"^",PIECE)),10)
91 .S TMP=$$INSERT^VAQUTL1(Y,TMP,43)
92 ;CALCULATE TOTAL FOR FIELD
93 S TOTAL=0,I="" F S I=$O(DGIN2(I)) Q:I="" S TOTAL=TOTAL+$P(DGIN2(I),"^",PIECE)
94 S Y=$J($$AMT^DGMTSCU1(TOTAL),12)
95 S TMP=$$INSERT^VAQUTL1(Y,TMP,67)
96 S @ARRAY@("DISPLAY",OFFSET,0)=TMP
97 S OFFSET=OFFSET+1
98 Q
Note: See TracBrowser for help on using the repository browser.