VAQDBIM3 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 3);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.
; **********
;
XTRCT3(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 3
;DEDUCTABLE EXPENSES INFORMATION
;This module is based on DIS^DGMTSC3
;
;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,DGCNT,DGDCS,DGDEP,DGIN1,DGINC,DGINR,DGREL,DGVIR0,TMP,LINES
N COUNT,CHILD
;EXTRACT HEADER
S LINES=OFFSET
S TMP=$$HEADER^VAQDBIM0(3,ARRAY,OFFSET)
Q:(TMP<0) TMP
S OFFSET=LINES+TMP
;INITIALIZE MEANS TEST VARIABLES
S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)),DGIN1("V")=$G(^DGMT(408.21,DGVINI,1))
S DGDC=$P(DGVIR0,"^",8) I DGDC D SET^DGMTSC31 S:'$D(DGDCS) DGDC=0
S TMP=$$INSERT^VAQUTL1("Medical Expenses: ","",19)_$$AMT^DGMTSCU1($P(DGIN1("V"),"^"))
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
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)))
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
S TMP=$$INSERT^VAQUTL1("Veteran's Educational Expenses: ","",5)_$$AMT^DGMTSCU1($P(DGIN1("V"),"^",3))
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=""
S OFFSET=OFFSET+1
S TMP=$$INSERT^VAQUTL1("Child's Education Expenses: ","",5)_$S('DGDC:"N/A",1:"")
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
;EXTRACT DEPENDENT CHILDREN WITH EMPLOYMENT INCOME
I DGDC D
.;SET COLUMN HEADINGS
.S @ARRAY@("DISPLAY",OFFSET,0)=""
.S OFFSET=OFFSET+1
.S TMP=$$INSERT^VAQUTL1("Child's","",9)
.S TMP=$$INSERT^VAQUTL1("Employment",TMP,25)
.S TMP=$$INSERT^VAQUTL1("Post-secondary",TMP,37)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
.S TMP=$$INSERT^VAQUTL1("First Name","",9)
.S TMP=$$INSERT^VAQUTL1("Income",TMP,25)
.S TMP=$$INSERT^VAQUTL1("Education Expenses",TMP,36)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
.S TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",12),"",9)
.S TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",10),TMP,25)
.S TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",18),TMP,37)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
.;EXTRACT INFO FOR EACH DEPENDENT CHILD
.S COUNT=0 F S COUNT=$O(DGDCS(COUNT)) Q:'COUNT S CHILD=DGDCS(COUNT) D CHILD
Q (OFFSET-LINES)
;
CHILD ;EXTRACT EMPLOYMENT INCOME AND EXPENSES FOR A DEPENDENT CHILD
;This module is based on CHILD^DGMTSC31
N DGIN0,DGIN1,TMP,Y
S DGIN0=$G(^DGMT(408.21,+$G(DGINC("C",CHILD)),0)),DGIN1=$G(^(1))
S TMP=$$INSERT^VAQUTL1((COUNT_"."),"",5)
S Y=$E($P($$NAME^DGMTU1(+DGREL("C",CHILD)),",",2),1,12)
S TMP=$$INSERT^VAQUTL1(Y,TMP,9)
S Y=$J($$AMT^DGMTSCU1($P(DGIN0,"^",14)),10)
S TMP=$$INSERT^VAQUTL1(Y,TMP,25)
S Y=$J($S(($P(DGIN0,"^",14)-$P(DGMTPAR,"^",17))>0:$$AMT^DGMTSCU1($P(DGIN1,"^",3)),1:"N/A"),10)
S TMP=$$INSERT^VAQUTL1(Y,TMP,45)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM3 3474 printed Apr 09, 2024@21:27:27 Page 2
VAQDBIM3 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 3);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 ;
XTRCT3(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 3
+1 ;DEDUCTABLE EXPENSES INFORMATION
+2 ;This module is based on DIS^DGMTSC3
+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,DGCNT,DGDCS,DGDEP,DGIN1,DGINC,DGINR,DGREL,DGVIR0,TMP,LINES
+15 NEW COUNT,CHILD
+16 ;EXTRACT HEADER
+17 SET LINES=OFFSET
+18 SET TMP=$$HEADER^VAQDBIM0(3,ARRAY,OFFSET)
+19 if (TMP<0)
QUIT TMP
+20 SET OFFSET=LINES+TMP
+21 ;INITIALIZE MEANS TEST VARIABLES
+22 SET DGVIR0=$GET(^DGMT(408.22,DGVIRI,0))
SET DGIN1("V")=$GET(^DGMT(408.21,DGVINI,1))
+23 SET DGDC=$PIECE(DGVIR0,"^",8)
IF DGDC
DO SET^DGMTSC31
if '$DATA(DGDCS)
SET DGDC=0
+24 SET TMP=$$INSERT^VAQUTL1("Medical Expenses: ","",19)_$$AMT^DGMTSCU1($PIECE(DGIN1("V"),"^"))
+25 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+26 SET OFFSET=OFFSET+1
+27 SET TMP=$$INSERT^VAQUTL1("Funeral and Burial Expenses: ","",8)_$SELECT('$PIECE(DGVIR0,"^",5)&('$PIECE(DGVIR0,"^",8)):"N/A",1:$$AMT^DGMTSCU1($PIECE(DGIN1("V"),"^",2)))
+28 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+29 SET OFFSET=OFFSET+1
+30 SET TMP=$$INSERT^VAQUTL1("Veteran's Educational Expenses: ","",5)_$$AMT^DGMTSCU1($PIECE(DGIN1("V"),"^",3))
+31 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+32 SET OFFSET=OFFSET+1
+33 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+34 SET OFFSET=OFFSET+1
+35 SET TMP=$$INSERT^VAQUTL1("Child's Education Expenses: ","",5)_$SELECT('DGDC:"N/A",1:"")
+36 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+37 SET OFFSET=OFFSET+1
+38 ;EXTRACT DEPENDENT CHILDREN WITH EMPLOYMENT INCOME
+39 IF DGDC
Begin DoDot:1
+40 ;SET COLUMN HEADINGS
+41 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+42 SET OFFSET=OFFSET+1
+43 SET TMP=$$INSERT^VAQUTL1("Child's","",9)
+44 SET TMP=$$INSERT^VAQUTL1("Employment",TMP,25)
+45 SET TMP=$$INSERT^VAQUTL1("Post-secondary",TMP,37)
+46 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+47 SET OFFSET=OFFSET+1
+48 SET TMP=$$INSERT^VAQUTL1("First Name","",9)
+49 SET TMP=$$INSERT^VAQUTL1("Income",TMP,25)
+50 SET TMP=$$INSERT^VAQUTL1("Education Expenses",TMP,36)
+51 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+52 SET OFFSET=OFFSET+1
+53 SET TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",12),"",9)
+54 SET TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",10),TMP,25)
+55 SET TMP=$$INSERT^VAQUTL1($$REPEAT^VAQUTL1("-",18),TMP,37)
+56 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+57 SET OFFSET=OFFSET+1
+58 ;EXTRACT INFO FOR EACH DEPENDENT CHILD
+59 SET COUNT=0
FOR
SET COUNT=$ORDER(DGDCS(COUNT))
if 'COUNT
QUIT
SET CHILD=DGDCS(COUNT)
DO CHILD
End DoDot:1
+60 QUIT (OFFSET-LINES)
+61 ;
CHILD ;EXTRACT EMPLOYMENT INCOME AND EXPENSES FOR A DEPENDENT CHILD
+1 ;This module is based on CHILD^DGMTSC31
+2 NEW DGIN0,DGIN1,TMP,Y
+3 SET DGIN0=$GET(^DGMT(408.21,+$GET(DGINC("C",CHILD)),0))
SET DGIN1=$GET(^(1))
+4 SET TMP=$$INSERT^VAQUTL1((COUNT_"."),"",5)
+5 SET Y=$EXTRACT($PIECE($$NAME^DGMTU1(+DGREL("C",CHILD)),",",2),1,12)
+6 SET TMP=$$INSERT^VAQUTL1(Y,TMP,9)
+7 SET Y=$JUSTIFY($$AMT^DGMTSCU1($PIECE(DGIN0,"^",14)),10)
+8 SET TMP=$$INSERT^VAQUTL1(Y,TMP,25)
+9 SET Y=$JUSTIFY($SELECT(($PIECE(DGIN0,"^",14)-$PIECE(DGMTPAR,"^",17))>0:$$AMT^DGMTSCU1($PIECE(DGIN1,"^",3)),1:"N/A"),10)
+10 SET TMP=$$INSERT^VAQUTL1(Y,TMP,45)
+11 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+12 SET OFFSET=OFFSET+1
+13 QUIT
