| [613] | 1 | VAQDBIM2 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 2);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 | ;
|
|---|
| 9 | XTRCT2(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 2
|
|---|
| 10 | ;PREVIOUS CALENDAR YEAR GROSS INCOME
|
|---|
| 11 | ;This module is based on DIS^DGMTSC2
|
|---|
| 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,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,LINES,TMP
|
|---|
| 24 | S LINES=OFFSET
|
|---|
| 25 | ;INITIALEZE MEANS TEST VARIABLES
|
|---|
| 26 | D DEP^DGMTSCU2,INC^DGMTSCU3
|
|---|
| 27 | ;EXTRACT HEADER
|
|---|
| 28 | S TMP=$$HEADER^VAQDBIM0(2,ARRAY,OFFSET)
|
|---|
| 29 | Q:(TMP<0) TMP
|
|---|
| 30 | S OFFSET=OFFSET+TMP
|
|---|
| 31 | ;EXTRACT INFORMATION
|
|---|
| 32 | S TMP=$$INSERT^VAQUTL1("Veteran","",35)
|
|---|
| 33 | S:(DGSP) TMP=$$INSERT^VAQUTL1("Spouse",TMP,47)
|
|---|
| 34 | S:(DGDC) TMP=$$INSERT^VAQUTL1("Children",TMP,57)
|
|---|
| 35 | S TMP=$$INSERT^VAQUTL1("Total",TMP,74)
|
|---|
| 36 | S @ARRAY@("DISPLAY",OFFSET,0)=TMP
|
|---|
| 37 | S OFFSET=OFFSET+1
|
|---|
| 38 | S TMP=$$REPEAT^VAQUTL1("-",47)
|
|---|
| 39 | S TMP=$$INSERT^VAQUTL1(TMP,"",32)
|
|---|
| 40 | S @ARRAY@("DISPLAY",OFFSET,0)=TMP
|
|---|
| 41 | S OFFSET=OFFSET+1
|
|---|
| 42 | D FLD(8,"Social Security (Not SSI)")
|
|---|
| 43 | D FLD(9,"U.S. Civil Service")
|
|---|
| 44 | D FLD(10,"U.S. Railroad Retirement")
|
|---|
| 45 | D FLD(11,"Military Retirement")
|
|---|
| 46 | D FLD(12,"Unemployment Compensation")
|
|---|
| 47 | D FLD(13,"Other Retirement")
|
|---|
| 48 | D FLD(14,"Total Employment Income")
|
|---|
| 49 | D FLD(15,"Interest,Dividend,Annuity")
|
|---|
| 50 | D FLD(16,"Workers Comp or Black Lung")
|
|---|
| 51 | D FLD(17,"All Other Income")
|
|---|
| 52 | S TMP=$$INSERT^VAQUTL1("Total -->","",52)
|
|---|
| 53 | S TMP=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1(DGINT),12),TMP,67)
|
|---|
| 54 | S @ARRAY@("DISPLAY",OFFSET,0)=TMP
|
|---|
| 55 | S OFFSET=OFFSET+1
|
|---|
| 56 | Q (OFFSET-LINES)
|
|---|
| 57 | ;
|
|---|
| 58 | FLD(PIECE,LABEL) ;EXTRACT INCOME
|
|---|
| 59 | ;INPUT : PIECE - Piece position in DGIN0 to extract
|
|---|
| 60 | ; LABEL - Label to use (income description)
|
|---|
| 61 | ; Input also includes:
|
|---|
| 62 | ; all DG* variables
|
|---|
| 63 | ; ARRAY
|
|---|
| 64 | ; OFFSET
|
|---|
| 65 | ;
|
|---|
| 66 | ;This module is based on FLD^DGMTSC2
|
|---|
| 67 | ;
|
|---|
| 68 | ;DECLARE VARIABLES
|
|---|
| 69 | N TOTAL,I,INFO
|
|---|
| 70 | ;PLACE LABEL IN STRING
|
|---|
| 71 | S INFO=$$INSERT^VAQUTL1(LABEL,"",6)
|
|---|
| 72 | ;EXTRACT INCOME INFORMATION
|
|---|
| 73 | S INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1($P(DGIN0("V"),"^",PIECE)),10),INFO,32)
|
|---|
| 74 | S:$D(DGIN0("S")) INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1($P(DGIN0("S"),"^",PIECE)),10),INFO,43)
|
|---|
| 75 | S:$D(DGIN0("C")) INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1($P(DGIN0("C"),"^",PIECE)),11),INFO,54)
|
|---|
| 76 | ;CALCULATE INCOME TOTAL
|
|---|
| 77 | S TOTAL=0,I="" F S I=$O(DGIN0(I)) Q:I="" S TOTAL=TOTAL+$P(DGIN0(I),"^",PIECE)
|
|---|
| 78 | S INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1(TOTAL),12),INFO,67)
|
|---|
| 79 | S @ARRAY@("DISPLAY",OFFSET,0)=INFO
|
|---|
| 80 | S OFFSET=OFFSET+1
|
|---|
| 81 | Q
|
|---|
