VAQDBIM1 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 1);28-FEB-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.
; **********
;
XTRCT1(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 1
;MARITAL STATUS/DEPENDENT INFORMATION
;This module is based on DIS^DGMTSC1
;
;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 DGDEP,DGINR,DGREL,DGVIR0,X,TMP,COUNT,LINES
;EXTRACT HEADER
S LINES=OFFSET
S TMP=$$HEADER^VAQDBIM0(1,ARRAY,OFFSET)
Q:(TMP<0) TMP
S OFFSET=LINES+TMP
;INITIALIZE MEANS TEST VARIABLES
D ALL^DGMTU21(DFN,"CS",DGMTDT,"PR")
S DGVIR0=$G(^DGMT(408.22,DGVIRI,0))
;EXTRACT MARITAL STATUS INFORMATION
S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Was marital status married or separated on Dec 31st last year: ","",5)_$$YN^DGMTSCU1($P(DGVIR0,"^",5))
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Did you live with your spouse last year: ","",27)_$S($P(DGVIR0,"^",5)=0:"N/A",1:$$YN^DGMTSCU1($P(DGVIR0,"^",6)))
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Amount contributed to spouse: ","",38)_$S($P(DGVIR0,"^",5)=0!($P(DGVIR0,"^",6)):"N/A",1:$$AMT^DGMTSCU1($P(DGVIR0,"^",7)))
S OFFSET=OFFSET+1
I $P(DGVIR0,"^",5),$D(DGREL("S")) D
.;SPOUSE'S INFORMATION
.S @ARRAY@("DISPLAY",OFFSET,0)=""
.S OFFSET=OFFSET+1
.S TMP=$$INSERT^VAQUTL1("Spouse's Name: ","",5)_$E($$NAME^DGMTU1(+DGREL("S")),1,15)
.S X="SSN: "_$$SSN^DGMTU1(+DGREL("S"))
.S TMP=$$INSERT^VAQUTL1(X,TMP,37)
.S X="DOB: "_$$DOB^DGMTU1(+DGREL("S"))
.S TMP=$$INSERT^VAQUTL1(X,TMP,57)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=""
S OFFSET=OFFSET+1
;EXTRACT DEPENDENT CHILDREN INFORMATION
S TMP=$$INSERT^VAQUTL1("Dependent Children: ","",5)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP_$$YN^DGMTSCU1($P(DGVIR0,"^",8))
S OFFSET=OFFSET+1
I $P(DGVIR0,"^",8) D
.;EXTRACT INFORMATION FOR ALL DEPENDENT CHILDREN
.S @ARRAY@("DISPLAY",OFFSET,0)=""
.S OFFSET=OFFSET+1
.;COLUMN HEADINGS
.S TMP=$$INSERT^VAQUTL1("Child's","",9)
.S TMP=$$INSERT^VAQUTL1("Incapable of",TMP,22)
.S TMP=$$INSERT^VAQUTL1("Child lived",TMP,35)
.S TMP=$$INSERT^VAQUTL1("Child",TMP,47)
.S TMP=$$INSERT^VAQUTL1("Child's",TMP,58)
.S TMP=$$INSERT^VAQUTL1("Income",TMP,69)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
.S TMP=$$INSERT^VAQUTL1("First Name","",9)
.S TMP=$$INSERT^VAQUTL1("Self-support",TMP,22)
.S TMP=$$INSERT^VAQUTL1("with you",TMP,35)
.S TMP=$$INSERT^VAQUTL1("Support",TMP,47)
.S TMP=$$INSERT^VAQUTL1("Income",TMP,58)
.S TMP=$$INSERT^VAQUTL1("Available",TMP,69)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
.S TMP=""
.F COUNT=9,22,35,47,58,69 S TMP=$$INSERT^VAQUTL1("----------",TMP,COUNT)
.S @ARRAY@("DISPLAY",OFFSET,0)=TMP
.S OFFSET=OFFSET+1
.;EXTRACT INFORMATION
.S COUNT=0
.F S COUNT=$O(DGREL("C",COUNT)) Q:'COUNT D CHILD
.Q
Q (OFFSET-LINES)
;
CHILD ;EXTRACT DATA COLLECTED FOR A DEPENDENT CHILD
;This module is based on CHILD^DGMTSC11
;DECLARE VARIABLES
N DGIR0,TMP
;INITIALIZE MEANS TEST VARIABLE
S DGIR0=$G(^DGMT(408.22,+$G(DGINR("C",COUNT)),0))
;EXTRACT INFORMATION
S TMP=$$INSERT^VAQUTL1((COUNT_"."),"",5)
S TMP=$$INSERT^VAQUTL1($E($P($$NAME^DGMTU1(+DGREL("C",COUNT)),",",2),1,12),TMP,9)
S TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($P(DGIR0,"^",9)),TMP,22)
S TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($P(DGIR0,"^",6)),TMP,35)
S TMP=$$INSERT^VAQUTL1($S($P(DGIR0,"^",6):"N/A",1:$$YN^DGMTSCU1($P(DGIR0,"^",10))),TMP,47)
S TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($P(DGIR0,"^",11)),TMP,58)
S TMP=$$INSERT^VAQUTL1($S($P(DGIR0,"^",11)=0:"N/A",1:$$YN^DGMTSCU1($P(DGIR0,"^",12))),TMP,69)
S @ARRAY@("DISPLAY",OFFSET,0)=TMP
S OFFSET=OFFSET+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM1 4263 printed Sep 23, 2025@20:00:43 Page 2
VAQDBIM1 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 1);28-FEB-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 ;
XTRCT1(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 1
+1 ;MARITAL STATUS/DEPENDENT INFORMATION
+2 ;This module is based on DIS^DGMTSC1
+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 DGDEP,DGINR,DGREL,DGVIR0,X,TMP,COUNT,LINES
+15 ;EXTRACT HEADER
+16 SET LINES=OFFSET
+17 SET TMP=$$HEADER^VAQDBIM0(1,ARRAY,OFFSET)
+18 if (TMP<0)
QUIT TMP
+19 SET OFFSET=LINES+TMP
+20 ;INITIALIZE MEANS TEST VARIABLES
+21 DO ALL^DGMTU21(DFN,"CS",DGMTDT,"PR")
+22 SET DGVIR0=$GET(^DGMT(408.22,DGVIRI,0))
+23 ;EXTRACT MARITAL STATUS INFORMATION
+24 SET @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Was marital status married or separated on Dec 31st last year: ","",5)_$$YN^DGMTSCU1($PIECE(DGVIR0,"^",5))
+25 SET OFFSET=OFFSET+1
+26 SET @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Did you live with your spouse last year: ","",27)_$SELECT($PIECE(DGVIR0,"^",5)=0:"N/A",1:$$YN^DGMTSCU1($PIECE(DGVIR0,"^",6)))
+27 SET OFFSET=OFFSET+1
+28 SET @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Amount contributed to spouse: ","",38)_$SELECT($PIECE(DGVIR0,"^",5)=0!($PIECE(DGVIR0,"^",6)):"N/A",1:$$AMT^DGMTSCU1($PIECE(DGVIR0,"^",7)))
+29 SET OFFSET=OFFSET+1
+30 IF $PIECE(DGVIR0,"^",5)
IF $DATA(DGREL("S"))
Begin DoDot:1
+31 ;SPOUSE'S INFORMATION
+32 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+33 SET OFFSET=OFFSET+1
+34 SET TMP=$$INSERT^VAQUTL1("Spouse's Name: ","",5)_$EXTRACT($$NAME^DGMTU1(+DGREL("S")),1,15)
+35 SET X="SSN: "_$$SSN^DGMTU1(+DGREL("S"))
+36 SET TMP=$$INSERT^VAQUTL1(X,TMP,37)
+37 SET X="DOB: "_$$DOB^DGMTU1(+DGREL("S"))
+38 SET TMP=$$INSERT^VAQUTL1(X,TMP,57)
+39 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+40 SET OFFSET=OFFSET+1
End DoDot:1
+41 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+42 SET OFFSET=OFFSET+1
+43 ;EXTRACT DEPENDENT CHILDREN INFORMATION
+44 SET TMP=$$INSERT^VAQUTL1("Dependent Children: ","",5)
+45 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP_$$YN^DGMTSCU1($PIECE(DGVIR0,"^",8))
+46 SET OFFSET=OFFSET+1
+47 IF $PIECE(DGVIR0,"^",8)
Begin DoDot:1
+48 ;EXTRACT INFORMATION FOR ALL DEPENDENT CHILDREN
+49 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+50 SET OFFSET=OFFSET+1
+51 ;COLUMN HEADINGS
+52 SET TMP=$$INSERT^VAQUTL1("Child's","",9)
+53 SET TMP=$$INSERT^VAQUTL1("Incapable of",TMP,22)
+54 SET TMP=$$INSERT^VAQUTL1("Child lived",TMP,35)
+55 SET TMP=$$INSERT^VAQUTL1("Child",TMP,47)
+56 SET TMP=$$INSERT^VAQUTL1("Child's",TMP,58)
+57 SET TMP=$$INSERT^VAQUTL1("Income",TMP,69)
+58 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+59 SET OFFSET=OFFSET+1
+60 SET TMP=$$INSERT^VAQUTL1("First Name","",9)
+61 SET TMP=$$INSERT^VAQUTL1("Self-support",TMP,22)
+62 SET TMP=$$INSERT^VAQUTL1("with you",TMP,35)
+63 SET TMP=$$INSERT^VAQUTL1("Support",TMP,47)
+64 SET TMP=$$INSERT^VAQUTL1("Income",TMP,58)
+65 SET TMP=$$INSERT^VAQUTL1("Available",TMP,69)
+66 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+67 SET OFFSET=OFFSET+1
+68 SET TMP=""
+69 FOR COUNT=9,22,35,47,58,69
SET TMP=$$INSERT^VAQUTL1("----------",TMP,COUNT)
+70 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+71 SET OFFSET=OFFSET+1
+72 ;EXTRACT INFORMATION
+73 SET COUNT=0
+74 FOR
SET COUNT=$ORDER(DGREL("C",COUNT))
if 'COUNT
QUIT
DO CHILD
+75 QUIT
End DoDot:1
+76 QUIT (OFFSET-LINES)
+77 ;
CHILD ;EXTRACT DATA COLLECTED FOR A DEPENDENT CHILD
+1 ;This module is based on CHILD^DGMTSC11
+2 ;DECLARE VARIABLES
+3 NEW DGIR0,TMP
+4 ;INITIALIZE MEANS TEST VARIABLE
+5 SET DGIR0=$GET(^DGMT(408.22,+$GET(DGINR("C",COUNT)),0))
+6 ;EXTRACT INFORMATION
+7 SET TMP=$$INSERT^VAQUTL1((COUNT_"."),"",5)
+8 SET TMP=$$INSERT^VAQUTL1($EXTRACT($PIECE($$NAME^DGMTU1(+DGREL("C",COUNT)),",",2),1,12),TMP,9)
+9 SET TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($PIECE(DGIR0,"^",9)),TMP,22)
+10 SET TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($PIECE(DGIR0,"^",6)),TMP,35)
+11 SET TMP=$$INSERT^VAQUTL1($SELECT($PIECE(DGIR0,"^",6):"N/A",1:$$YN^DGMTSCU1($PIECE(DGIR0,"^",10))),TMP,47)
+12 SET TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($PIECE(DGIR0,"^",11)),TMP,58)
+13 SET TMP=$$INSERT^VAQUTL1($SELECT($PIECE(DGIR0,"^",11)=0:"N/A",1:$$YN^DGMTSCU1($PIECE(DGIR0,"^",12))),TMP,69)
+14 SET @ARRAY@("DISPLAY",OFFSET,0)=TMP
+15 SET OFFSET=OFFSET+1
+16 QUIT
