VAQDBIM2 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 2);4-MAR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
; **********
; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
; **********
;
XTRCT2(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 2
;PREVIOUS CALENDAR YEAR GROSS INCOME
;This module is based on DIS^DGMTSC2
;
;INPUT : See EXTRACT^VAQDBIM for explanation of parameters. Input
; also includes all DG* variables required to build screen.
;OUTPUT : n - Number of lines in display
; -1^Error_text - Error
;
;CHECK INPUT
Q:('$D(DFN)) "-1^Pointer to patient file not passed"
Q:('$D(ARRAY)) "-1^Reference to output array not passed"
Q:('$D(OFFSET)) "-1^Starting offset not passed"
;DECLARE VARIABLES
N DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,LINES,TMP
S LINES=OFFSET
;INITIALEZE MEANS TEST VARIABLES
D DEP^DGMTSCU2,INC^DGMTSCU3
;EXTRACT HEADER
S TMP=$$HEADER^VAQDBIM0(2,ARRAY,OFFSET)
Q:(TMP<0) TMP
S OFFSET=OFFSET+TMP
;EXTRACT INFORMATION
S TMP=$$INSERT^VAQUTL1("Veteran","",35)
S:(DGSP) TMP=$$INSERT^VAQUTL1("Spouse",TMP,47)
S:(DGDC) TMP=$$INSERT^VAQUTL1("Children",TMP,57)
S TMP=$$INSERT^VAQUTL1("Total",TMP,74)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
S TMP=$$REPEAT^VAQUTL1("-",47)
S TMP=$$INSERT^VAQUTL1(TMP,"",32)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
D FLD(8,"Social Security (Not SSI)")
D FLD(9,"U.S. Civil Service")
D FLD(10,"U.S. Railroad Retirement")
D FLD(11,"Military Retirement")
D FLD(12,"Unemployment Compensation")
D FLD(13,"Other Retirement")
D FLD(14,"Total Employment Income")
D FLD(15,"Interest,Dividend,Annuity")
D FLD(16,"Workers Comp or Black Lung")
D FLD(17,"All Other Income")
S TMP=$$INSERT^VAQUTL1("Total -->","",52)
S TMP=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1(DGINT),12),TMP,67)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
Q (OFFSET-LINES)
;
FLD(PIECE,LABEL) ;EXTRACT INCOME
;INPUT : PIECE - Piece position in DGIN0 to extract
; LABEL - Label to use (income description)
; Input also includes:
; all DG* variables
; ARRAY
; OFFSET
;
;This module is based on FLD^DGMTSC2
;
;DECLARE VARIABLES
N TOTAL,I,INFO
;PLACE LABEL IN STRING
S INFO=$$INSERT^VAQUTL1(LABEL,"",6)
;EXTRACT INCOME INFORMATION
S INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1($P(DGIN0("V"),"^",PIECE)),10),INFO,32)
S:$D(DGIN0("S")) INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1($P(DGIN0("S"),"^",PIECE)),10),INFO,43)
S:$D(DGIN0("C")) INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1($P(DGIN0("C"),"^",PIECE)),11),INFO,54)
;CALCULATE INCOME TOTAL
S TOTAL=0,I="" F S I=$O(DGIN0(I)) Q:I="" S TOTAL=TOTAL+$P(DGIN0(I),"^",PIECE)
S INFO=$$INSERT^VAQUTL1($J($$AMT^DGMTSCU1(TOTAL),12),INFO,67)
S @ARRAY@("DISPLAY",OFFSET,0)=INFO
S OFFSET=OFFSET+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM2 3015 printed Dec 13, 2024@02:25:05 Page 2
VAQDBIM2 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 2);4-MAR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
+2 ; **********
+3 ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
+4 ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
+5 ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
+6 ; **********
+7 ;
XTRCT2(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 2
+1 ;PREVIOUS CALENDAR YEAR GROSS INCOME
+2 ;This module is based on DIS^DGMTSC2
+3 ;
+4 ;INPUT : See EXTRACT^VAQDBIM for explanation of parameters. Input
+5 ; also includes all DG* variables required to build screen.
+6 ;OUTPUT : n - Number of lines in display
+7 ; -1^Error_text - Error
+8 ;
+9 ;CHECK INPUT
+10 if ('$DATA(DFN))
QUIT "-1^Pointer to patient file not passed"
+11 if ('$DATA(ARRAY))
QUIT "-1^Reference to output array not passed"
+12 if ('$DATA(OFFSET))
QUIT "-1^Starting offset not passed"
+13 ;DECLARE VARIABLES
+14 NEW DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGNC,DGND,DGNWT,DGNWTF,DGSP,DGVIR0,LINES,TMP
+15 SET LINES=OFFSET
+16 ;INITIALEZE MEANS TEST VARIABLES
+17 DO DEP^DGMTSCU2
DO INC^DGMTSCU3
+18 ;EXTRACT HEADER
+19 SET TMP=$$HEADER^VAQDBIM0(2,ARRAY,OFFSET)
+20 if (TMP<0)
QUIT TMP
+21 SET OFFSET=OFFSET+TMP
+22 ;EXTRACT INFORMATION
+23 SET TMP=$$INSERT^VAQUTL1("Veteran","",35)
+24 if (DGSP)
SET TMP=$$INSERT^VAQUTL1("Spouse",TMP,47)
+25 if (DGDC)
SET TMP=$$INSERT^VAQUTL1("Children",TMP,57)
+26 SET TMP=$$INSERT^VAQUTL1("Total",TMP,74)
+27 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+28 SET OFFSET=OFFSET+1
+29 SET TMP=$$REPEAT^VAQUTL1("-",47)
+30 SET TMP=$$INSERT^VAQUTL1(TMP,"",32)
+31 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+32 SET OFFSET=OFFSET+1
+33 DO FLD(8,"Social Security (Not SSI)")
+34 DO FLD(9,"U.S. Civil Service")
+35 DO FLD(10,"U.S. Railroad Retirement")
+36 DO FLD(11,"Military Retirement")
+37 DO FLD(12,"Unemployment Compensation")
+38 DO FLD(13,"Other Retirement")
+39 DO FLD(14,"Total Employment Income")
+40 DO FLD(15,"Interest,Dividend,Annuity")
+41 DO FLD(16,"Workers Comp or Black Lung")
+42 DO FLD(17,"All Other Income")
+43 SET TMP=$$INSERT^VAQUTL1("Total -->","",52)
+44 SET TMP=$$INSERT^VAQUTL1($JUSTIFY($$AMT^DGMTSCU1(DGINT),12),TMP,67)
+45 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+46 SET OFFSET=OFFSET+1
+47 QUIT (OFFSET-LINES)
+48 ;
FLD(PIECE,LABEL) ;EXTRACT INCOME
+1 ;INPUT : PIECE - Piece position in DGIN0 to extract
+2 ; LABEL - Label to use (income description)
+3 ; Input also includes:
+4 ; all DG* variables
+5 ; ARRAY
+6 ; OFFSET
+7 ;
+8 ;This module is based on FLD^DGMTSC2
+9 ;
+10 ;DECLARE VARIABLES
+11 NEW TOTAL,I,INFO
+12 ;PLACE LABEL IN STRING
+13 SET INFO=$$INSERT^VAQUTL1(LABEL,"",6)
+14 ;EXTRACT INCOME INFORMATION
+15 SET INFO=$$INSERT^VAQUTL1($JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN0("V"),"^",PIECE)),10),INFO,32)
+16 if $DATA(DGIN0("S"))
SET INFO=$$INSERT^VAQUTL1($JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN0("S"),"^",PIECE)),10),INFO,43)
+17 if $DATA(DGIN0("C"))
SET INFO=$$INSERT^VAQUTL1($JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN0("C"),"^",PIECE)),11),INFO,54)
+18 ;CALCULATE INCOME TOTAL
+19 SET TOTAL=0
SET I=""
FOR
SET I=$ORDER(DGIN0(I))
if I=""
QUIT
SET TOTAL=TOTAL+$PIECE(DGIN0(I),"^",PIECE)
+20 SET INFO=$$INSERT^VAQUTL1($JUSTIFY($$AMT^DGMTSCU1(TOTAL),12),INFO,67)
+21 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+22 SET OFFSET=OFFSET+1
+23 QUIT
