Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQDBIM1

VAQDBIM1.m

Go to the documentation of this file.
  1. VAQDBIM1 ;ALB/JRP - MEANS TEST EXTRACTION (SCREEN 1);28-FEB-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. ; **********
  1. ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
  1. ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
  1. ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
  1. ; **********
  1. ;
  1. XTRCT1(DFN,ARRAY,OFFSET) ;EXTRACT SCREEN 1
  1. ;MARITAL STATUS/DEPENDENT INFORMATION
  1. ;This module is based on DIS^DGMTSC1
  1. ;
  1. ;INPUT : See EXTRACT^VAQDBIM for explanation of parameters. Input
  1. ; also includes all DG* variables required to build screen.
  1. ;OUTPUT : n - Number of lines in display
  1. ; -1^Error_text - Error
  1. ;
  1. ;CHECK INPUT
  1. Q:('$D(DFN)) "-1^Pointer to patient file not passed"
  1. Q:('$D(ARRAY)) "-1^Reference to output array not passed"
  1. Q:('$D(OFFSET)) "-1^Starting offset not passed"
  1. ;DECLARE VARIABLES
  1. N DGDEP,DGINR,DGREL,DGVIR0,X,TMP,COUNT,LINES
  1. ;EXTRACT HEADER
  1. S LINES=OFFSET
  1. S TMP=$$HEADER^VAQDBIM0(1,ARRAY,OFFSET)
  1. Q:(TMP<0) TMP
  1. S OFFSET=LINES+TMP
  1. ;INITIALIZE MEANS TEST VARIABLES
  1. D ALL^DGMTU21(DFN,"CS",DGMTDT,"PR")
  1. S DGVIR0=$G(^DGMT(408.22,DGVIRI,0))
  1. ;EXTRACT MARITAL STATUS INFORMATION
  1. S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1("Was marital status married or separated on Dec 31st last year: ","",5)_$$YN^DGMTSCU1($P(DGVIR0,"^",5))
  1. S OFFSET=OFFSET+1
  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)))
  1. S OFFSET=OFFSET+1
  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)))
  1. S OFFSET=OFFSET+1
  1. I $P(DGVIR0,"^",5),$D(DGREL("S")) D
  1. .;SPOUSE'S INFORMATION
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. .S OFFSET=OFFSET+1
  1. .S TMP=$$INSERT^VAQUTL1("Spouse's Name: ","",5)_$E($$NAME^DGMTU1(+DGREL("S")),1,15)
  1. .S X="SSN: "_$$SSN^DGMTU1(+DGREL("S"))
  1. .S TMP=$$INSERT^VAQUTL1(X,TMP,37)
  1. .S X="DOB: "_$$DOB^DGMTU1(+DGREL("S"))
  1. .S TMP=$$INSERT^VAQUTL1(X,TMP,57)
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
  1. .S OFFSET=OFFSET+1
  1. S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. S OFFSET=OFFSET+1
  1. ;EXTRACT DEPENDENT CHILDREN INFORMATION
  1. S TMP=$$INSERT^VAQUTL1("Dependent Children: ","",5)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=TMP_$$YN^DGMTSCU1($P(DGVIR0,"^",8))
  1. S OFFSET=OFFSET+1
  1. I $P(DGVIR0,"^",8) D
  1. .;EXTRACT INFORMATION FOR ALL DEPENDENT CHILDREN
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. .S OFFSET=OFFSET+1
  1. .;COLUMN HEADINGS
  1. .S TMP=$$INSERT^VAQUTL1("Child's","",9)
  1. .S TMP=$$INSERT^VAQUTL1("Incapable of",TMP,22)
  1. .S TMP=$$INSERT^VAQUTL1("Child lived",TMP,35)
  1. .S TMP=$$INSERT^VAQUTL1("Child",TMP,47)
  1. .S TMP=$$INSERT^VAQUTL1("Child's",TMP,58)
  1. .S TMP=$$INSERT^VAQUTL1("Income",TMP,69)
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
  1. .S OFFSET=OFFSET+1
  1. .S TMP=$$INSERT^VAQUTL1("First Name","",9)
  1. .S TMP=$$INSERT^VAQUTL1("Self-support",TMP,22)
  1. .S TMP=$$INSERT^VAQUTL1("with you",TMP,35)
  1. .S TMP=$$INSERT^VAQUTL1("Support",TMP,47)
  1. .S TMP=$$INSERT^VAQUTL1("Income",TMP,58)
  1. .S TMP=$$INSERT^VAQUTL1("Available",TMP,69)
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
  1. .S OFFSET=OFFSET+1
  1. .S TMP=""
  1. .F COUNT=9,22,35,47,58,69 S TMP=$$INSERT^VAQUTL1("----------",TMP,COUNT)
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=TMP
  1. .S OFFSET=OFFSET+1
  1. .;EXTRACT INFORMATION
  1. .S COUNT=0
  1. .F S COUNT=$O(DGREL("C",COUNT)) Q:'COUNT D CHILD
  1. .Q
  1. Q (OFFSET-LINES)
  1. ;
  1. CHILD ;EXTRACT DATA COLLECTED FOR A DEPENDENT CHILD
  1. ;This module is based on CHILD^DGMTSC11
  1. ;DECLARE VARIABLES
  1. N DGIR0,TMP
  1. ;INITIALIZE MEANS TEST VARIABLE
  1. S DGIR0=$G(^DGMT(408.22,+$G(DGINR("C",COUNT)),0))
  1. ;EXTRACT INFORMATION
  1. S TMP=$$INSERT^VAQUTL1((COUNT_"."),"",5)
  1. S TMP=$$INSERT^VAQUTL1($E($P($$NAME^DGMTU1(+DGREL("C",COUNT)),",",2),1,12),TMP,9)
  1. S TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($P(DGIR0,"^",9)),TMP,22)
  1. S TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($P(DGIR0,"^",6)),TMP,35)
  1. S TMP=$$INSERT^VAQUTL1($S($P(DGIR0,"^",6):"N/A",1:$$YN^DGMTSCU1($P(DGIR0,"^",10))),TMP,47)
  1. S TMP=$$INSERT^VAQUTL1($$YN^DGMTSCU1($P(DGIR0,"^",11)),TMP,58)
  1. S TMP=$$INSERT^VAQUTL1($S($P(DGIR0,"^",11)=0:"N/A",1:$$YN^DGMTSCU1($P(DGIR0,"^",12))),TMP,69)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=TMP
  1. S OFFSET=OFFSET+1
  1. Q