- 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 Mar 13, 2025@21:29:36 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
