VAQDBIM4 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 4);5-MAR-93
;;1.5;PATIENT DATA EXCHANGE;**38**;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.
; **********
;
XTRCT4(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 1
;PREVIOUS CALENDAR YEAR NET WORTH
;This module is based on DIS^DGMTSC4
;
;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 DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC
N DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,TMP,LINES,Y
;INITIALIZE MEANS TEST VARIABLES
D SET^DGMTSCU2
;EXTRACT HEADER
S LINES=OFFSET
S TMP=$$HEADER^VAQDBIM0(4,ARRAY,OFFSET)
Q:(TMP<0) TMP
S OFFSET=LINES+TMP
;SET COLUMN HEADINGS
S TMP="Income Thresholds: "
I $D(DGTHA) D
.S Y="Category A: "_$$AMT^DGMTSCU1(DGTHA)
.S TMP=$$INSERT^VAQUTL1(Y,TMP)
I $D(DGTHB) D
.S Y="Category B: "_$$AMT^DGMTSCU1(DGTHB)
.S TMP=$$INSERT^VAQUTL1(Y,TMP,56)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
S TMP=""
S:$D(DGMTPAR("PREV")) TMP="*Previous Years Thresholds*"
S TMP=$$INSERT^VAQUTL1("Veteran",TMP,35)
S:DGSP TMP=$$INSERT^VAQUTL1("Spouse",TMP,47)
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(1,"Cash, Amts in Bank Accts")
D FLD(2,"Stocks and Bonds")
D FLD(3,"Real Property")
D FLD(4,"Other Property or Assets")
D FLD(5,"Debts")
S TMP=$$INSERT^VAQUTL1("Total -->","",52)
S Y=$J($$AMT^DGMTSCU1(DGNWT),12)
S TMP=$$INSERT^VAQUTL1(Y,TMP,67)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
F TMP=1:1:7 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
I $P($G(^DGMT(408.31,DGMTI,0)),U,14) S TMP="Declines to give income information makes a Category C."
E D
. S TMP="Income of "_$J($$AMT^DGMTSCU1(DGINT-DGDET),12)_" Category "_DGCAT
. I DGTYC="M",(DGNWT+DGINT-DGDET)>$P(DGMTPAR,"^",8) S TMP=TMP_" property of "_$J($$AMT^DGMTSCU1(DGNWT),12)_" makes a Category C."
. I DGTYC="M",'DGNWTF S TMP=TMP_" requires property information."
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
Q (OFFSET-LINES)
;
FLD(PIECE,LABEL) ;EXTRACT NET WORTH FIELDS
;INPUT : PIECE - Piece position in DGIN2 to extract
; LABEL - Label to use (income description)
; Input also includes:
; all DG* variables
; ARRAY
; OFFSET
;
;This module is based on FLD^DGMTSC4
;
;DECLARE VARIABLES
N TOTAL,I,TMP,Y
;EXTRACT INFO
S TMP=$$INSERT^VAQUTL1(LABEL,"",5)
S Y=$J($$AMT^DGMTSCU1($P(DGIN2("V"),"^",PIECE)),10)
S TMP=$$INSERT^VAQUTL1(Y,TMP,32)
I $D(DGIN2("S")) D
.S Y=$J($$AMT^DGMTSCU1($P(DGIN2("S"),"^",PIECE)),10)
.S TMP=$$INSERT^VAQUTL1(Y,TMP,43)
;CALCULATE TOTAL FOR FIELD
S TOTAL=0,I="" F S I=$O(DGIN2(I)) Q:I="" S TOTAL=TOTAL+$P(DGIN2(I),"^",PIECE)
S Y=$J($$AMT^DGMTSCU1(TOTAL),12)
S TMP=$$INSERT^VAQUTL1(Y,TMP,67)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM4 3539 printed Sep 23, 2025@20:00:46 Page 2
VAQDBIM4 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 4);5-MAR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**38**;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 ;
XTRCT4(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 1
+1 ;PREVIOUS CALENDAR YEAR NET WORTH
+2 ;This module is based on DIS^DGMTSC4
+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 DGCAT,DGDC,DGDET,DGIN0,DGIN1,DGIN2,DGINT,DGINTF,DGMTS,DGNC
+15 NEW DGND,DGNWT,DGNWTF,DGSP,DGTYC,DGTHA,DGTHB,DGVIR0,TMP,LINES,Y
+16 ;INITIALIZE MEANS TEST VARIABLES
+17 DO SET^DGMTSCU2
+18 ;EXTRACT HEADER
+19 SET LINES=OFFSET
+20 SET TMP=$$HEADER^VAQDBIM0(4,ARRAY,OFFSET)
+21 if (TMP<0)
QUIT TMP
+22 SET OFFSET=LINES+TMP
+23 ;SET COLUMN HEADINGS
+24 SET TMP="Income Thresholds: "
+25 IF $DATA(DGTHA)
Begin DoDot:1
+26 SET Y="Category A: "_$$AMT^DGMTSCU1(DGTHA)
+27 SET TMP=$$INSERT^VAQUTL1(Y,TMP)
End DoDot:1
+28 IF $DATA(DGTHB)
Begin DoDot:1
+29 SET Y="Category B: "_$$AMT^DGMTSCU1(DGTHB)
+30 SET TMP=$$INSERT^VAQUTL1(Y,TMP,56)
End DoDot:1
+31 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+32 SET OFFSET=OFFSET+1
+33 SET TMP=""
+34 if $DATA(DGMTPAR("PREV"))
SET TMP="*Previous Years Thresholds*"
+35 SET TMP=$$INSERT^VAQUTL1("Veteran",TMP,35)
+36 if DGSP
SET TMP=$$INSERT^VAQUTL1("Spouse",TMP,47)
+37 SET TMP=$$INSERT^VAQUTL1("Total",TMP,74)
+38 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+39 SET OFFSET=OFFSET+1
+40 SET TMP=$$REPEAT^VAQUTL1("-",47)
+41 SET TMP=$$INSERT^VAQUTL1(TMP,"",32)
+42 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+43 SET OFFSET=OFFSET+1
+44 DO FLD(1,"Cash, Amts in Bank Accts")
+45 DO FLD(2,"Stocks and Bonds")
+46 DO FLD(3,"Real Property")
+47 DO FLD(4,"Other Property or Assets")
+48 DO FLD(5,"Debts")
+49 SET TMP=$$INSERT^VAQUTL1("Total -->","",52)
+50 SET Y=$JUSTIFY($$AMT^DGMTSCU1(DGNWT),12)
+51 SET TMP=$$INSERT^VAQUTL1(Y,TMP,67)
+52 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+53 SET OFFSET=OFFSET+1
+54 FOR TMP=1:1:7
SET @ARRAY@("DISPLAY",OFFSET,0)=""
SET OFFSET=OFFSET+1
+55 IF $PIECE($GET(^DGMT(408.31,DGMTI,0)),U,14)
SET TMP="Declines to give income information makes a Category C."
+56 IF '$TEST
Begin DoDot:1
+57 SET TMP="Income of "_$JUSTIFY($$AMT^DGMTSCU1(DGINT-DGDET),12)_" Category "_DGCAT
+58 IF DGTYC="M"
IF (DGNWT+DGINT-DGDET)>$PIECE(DGMTPAR,"^",8)
SET TMP=TMP_" property of "_$JUSTIFY($$AMT^DGMTSCU1(DGNWT),12)_" makes a Category C."
+59 IF DGTYC="M"
IF 'DGNWTF
SET TMP=TMP_" requires property information."
End DoDot:1
+60 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+61 SET OFFSET=OFFSET+1
+62 QUIT (OFFSET-LINES)
+63 ;
FLD(PIECE,LABEL) ;EXTRACT NET WORTH FIELDS
+1 ;INPUT : PIECE - Piece position in DGIN2 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^DGMTSC4
+9 ;
+10 ;DECLARE VARIABLES
+11 NEW TOTAL,I,TMP,Y
+12 ;EXTRACT INFO
+13 SET TMP=$$INSERT^VAQUTL1(LABEL,"",5)
+14 SET Y=$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN2("V"),"^",PIECE)),10)
+15 SET TMP=$$INSERT^VAQUTL1(Y,TMP,32)
+16 IF $DATA(DGIN2("S"))
Begin DoDot:1
+17 SET Y=$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN2("S"),"^",PIECE)),10)
+18 SET TMP=$$INSERT^VAQUTL1(Y,TMP,43)
End DoDot:1
+19 ;CALCULATE TOTAL FOR FIELD
+20 SET TOTAL=0
SET I=""
FOR
SET I=$ORDER(DGIN2(I))
if I=""
QUIT
SET TOTAL=TOTAL+$PIECE(DGIN2(I),"^",PIECE)
+21 SET Y=$JUSTIFY($$AMT^DGMTSCU1(TOTAL),12)
+22 SET TMP=$$INSERT^VAQUTL1(Y,TMP,67)
+23 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+24 SET OFFSET=OFFSET+1
+25 QUIT
