- 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 Jan 18, 2025@03:25:46 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