VAQDBIM0 ;ALB/JRP - MEANS TEST EXTRACTION;1-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.
; **********
;
;INPUT : SCREEN - Screen number
; ARRAY - Where to store header (full global reference)
; OFFSET - Where to start adding lines
; Input also includes all DG* variables required to build
; the screen header.
;OUTPUT : n - Number of lines in display
; -1^Error_text - Error
;
;This module is based on HD^DGMTSCU
;
;CHECK INPUT
Q:('$D(SCREEN)) "-1^Screen number not passed"
Q:('$D(ARRAY)) "-1^Reference to output array not passed"
Q:('$D(OFFSET)) "-1^Offset not passed"
;DECLARE VARIABLES
N TMP,INFO,Y,LINES
S LINES=OFFSET
S TMP=$G(DGMTSC(SCREEN))
Q:(TMP="") "-1^Could not determine header information"
S INFO="----- "_$P(TMP,";",2)_" -----"
S TMP=((80-$L(INFO))\2)+1
S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1(INFO,"",TMP)
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=""
S OFFSET=OFFSET+1
Q (OFFSET-LINES)
;
TITLE(ARRAY,OFFSET) ;MAIN TITLE FOR MEANS TEST DATA SEGMENT
;INPUT : ARRAY - Where to store title (full global reference)
; OFFSET - Where to start adding lines
; Input also includes all DG* variables required to build
; the screen header.
;OUTPUT : n - Number of lines in display
; -1^Error_text - Error
;
;This module is based on HD^DGMTSCU
;
;CHECK INPUT
Q:('$D(ARRAY)) "-1^Reference to output array not passed"
Q:('$D(OFFSET)) "-1^Offset not passed"
;DECLARE VARIABLES
N TMP,INFO,Y,LINES
S LINES=OFFSET
S INFO=$$REPEAT^VAQUTL1("-",79)
S TMP="< Means Test Data >"
S Y=((80-$L(TMP))\2)+1
S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
S @ARRAY@("DISPLAY",OFFSET,0)=INFO
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=""
S OFFSET=OFFSET+1
S INFO="ANNUAL INCOME FOR "
S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") S INFO=INFO_Y
S Y=((80-$L(INFO))\2)+1
S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
S @ARRAY@("DISPLAY",OFFSET,0)=INFO
S OFFSET=OFFSET+1
S TMP=$$DOBFMT^VAQUTL99(DGMTDT,0)
S INFO="MEANS TEST DONE ON "_TMP
S Y=((80-$L(INFO))\2)+1
S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
S @ARRAY@("DISPLAY",OFFSET,0)=INFO
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=""
S OFFSET=OFFSET+1
Q (OFFSET-LINES)
;
ERROR(TRAN,ARRAY,OFFSET,REASON) ;ERROR DISPLAY
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; ARRAY - Where to store information (full global reference)
; OFFSET - Line segment started on
; REASON - Reason for error (optional)
;OUTPUT : n - Number of lines in display
; -1^Error_text - Error
;NOTES : If TRAN>0
; Encryption is based on the transaction
; Else
; Encryption is based ont the parameter file
;
;CHECK INPUT
S TRAN=+$G(TRAN)
I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
Q:('$D(ARRAY)) "-1^Reference to output array not passed"
Q:('$D(OFFSET)) "-1^Offset not passed"
S REASON=$G(REASON)
;DECLARE VARIABLES
N TMP,INFO,Y,LINES
S LINES=OFFSET
;DELETE WHAT HAS BEEN ADDED
S Y=$$KILLARR^VAQUTL1(ARRAY,"DISPLAY",LINES)
Q:(Y) Y
;CREATE ERROR SEGMENT
S INFO=$$REPEAT^VAQUTL1("-",79)
S TMP="< Means Test Data >"
S Y=((80-$L(TMP))\2)+1
S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
S @ARRAY@("DISPLAY",OFFSET,0)=INFO
S OFFSET=OFFSET+1
S @ARRAY@("DISPLAY",OFFSET,0)=""
S OFFSET=OFFSET+1
S TMP="Unable to extract Means Test data"
S Y=((80-$L(TMP))\2)+1
S INFO=$$INSERT^VAQUTL1(TMP,"",Y)
S @ARRAY@("DISPLAY",OFFSET,0)=INFO
S OFFSET=OFFSET+1
I (REASON'="") D
.S REASON="("_REASON_")"
.S Y=((80-$L(REASON))\2)+1
.S INFO=$$INSERT^VAQUTL1(REASON,"",Y)
.S @ARRAY@("DISPLAY",OFFSET,0)=INFO
.S OFFSET=OFFSET+1
F Y=1:1:2 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
S:(TRAN) TMP=$$TRANENC^VAQUTL3(TRAN,0)
S:('TRAN) TMP=$$NCRYPTON^VAQUTL2(0)
S:(TMP) TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
Q (OFFSET-LINES)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM0 4319 printed Sep 23, 2025@20:00:42 Page 2
VAQDBIM0 ;ALB/JRP - MEANS TEST EXTRACTION;1-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 ;
+1 ;INPUT : SCREEN - Screen number
+2 ; ARRAY - Where to store header (full global reference)
+3 ; OFFSET - Where to start adding lines
+4 ; Input also includes all DG* variables required to build
+5 ; the screen header.
+6 ;OUTPUT : n - Number of lines in display
+7 ; -1^Error_text - Error
+8 ;
+9 ;This module is based on HD^DGMTSCU
+10 ;
+11 ;CHECK INPUT
+12 if ('$DATA(SCREEN))
QUIT "-1^Screen number not passed"
+13 if ('$DATA(ARRAY))
QUIT "-1^Reference to output array not passed"
+14 if ('$DATA(OFFSET))
QUIT "-1^Offset not passed"
+15 ;DECLARE VARIABLES
+16 NEW TMP,INFO,Y,LINES
+17 SET LINES=OFFSET
+18 SET TMP=$GET(DGMTSC(SCREEN))
+19 if (TMP="")
QUIT "-1^Could not determine header information"
+20 SET INFO="----- "_$PIECE(TMP,";",2)_" -----"
+21 SET TMP=((80-$LENGTH(INFO))\2)+1
+22 SET @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1(INFO,"",TMP)
+23 SET OFFSET=OFFSET+1
+24 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+25 SET OFFSET=OFFSET+1
+26 QUIT (OFFSET-LINES)
+27 ;
TITLE(ARRAY,OFFSET) ;MAIN TITLE FOR MEANS TEST DATA SEGMENT
+1 ;INPUT : ARRAY - Where to store title (full global reference)
+2 ; OFFSET - Where to start adding lines
+3 ; Input also includes all DG* variables required to build
+4 ; the screen header.
+5 ;OUTPUT : n - Number of lines in display
+6 ; -1^Error_text - Error
+7 ;
+8 ;This module is based on HD^DGMTSCU
+9 ;
+10 ;CHECK INPUT
+11 if ('$DATA(ARRAY))
QUIT "-1^Reference to output array not passed"
+12 if ('$DATA(OFFSET))
QUIT "-1^Offset not passed"
+13 ;DECLARE VARIABLES
+14 NEW TMP,INFO,Y,LINES
+15 SET LINES=OFFSET
+16 SET INFO=$$REPEAT^VAQUTL1("-",79)
+17 SET TMP="< Means Test Data >"
+18 SET Y=((80-$LENGTH(TMP))\2)+1
+19 SET INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
+20 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+21 SET OFFSET=OFFSET+1
+22 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+23 SET OFFSET=OFFSET+1
+24 SET INFO="ANNUAL INCOME FOR "
+25 SET Y=$$LYR^DGMTSCU1(DGMTDT)
XECUTE ^DD("DD")
SET INFO=INFO_Y
+26 SET Y=((80-$LENGTH(INFO))\2)+1
+27 SET INFO=$$INSERT^VAQUTL1(INFO,"",Y)
+28 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+29 SET OFFSET=OFFSET+1
+30 SET TMP=$$DOBFMT^VAQUTL99(DGMTDT,0)
+31 SET INFO="MEANS TEST DONE ON "_TMP
+32 SET Y=((80-$LENGTH(INFO))\2)+1
+33 SET INFO=$$INSERT^VAQUTL1(INFO,"",Y)
+34 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+35 SET OFFSET=OFFSET+1
+36 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+37 SET OFFSET=OFFSET+1
+38 QUIT (OFFSET-LINES)
+39 ;
ERROR(TRAN,ARRAY,OFFSET,REASON) ;ERROR DISPLAY
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; ARRAY - Where to store information (full global reference)
+3 ; OFFSET - Line segment started on
+4 ; REASON - Reason for error (optional)
+5 ;OUTPUT : n - Number of lines in display
+6 ; -1^Error_text - Error
+7 ;NOTES : If TRAN>0
+8 ; Encryption is based on the transaction
+9 ; Else
+10 ; Encryption is based ont the parameter file
+11 ;
+12 ;CHECK INPUT
+13 SET TRAN=+$GET(TRAN)
+14 IF (TRAN)
if ('$DATA(^VAT(394.61,TRAN)))
QUIT "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
+15 if ('$DATA(ARRAY))
QUIT "-1^Reference to output array not passed"
+16 if ('$DATA(OFFSET))
QUIT "-1^Offset not passed"
+17 SET REASON=$GET(REASON)
+18 ;DECLARE VARIABLES
+19 NEW TMP,INFO,Y,LINES
+20 SET LINES=OFFSET
+21 ;DELETE WHAT HAS BEEN ADDED
+22 SET Y=$$KILLARR^VAQUTL1(ARRAY,"DISPLAY",LINES)
+23 if (Y)
QUIT Y
+24 ;CREATE ERROR SEGMENT
+25 SET INFO=$$REPEAT^VAQUTL1("-",79)
+26 SET TMP="< Means Test Data >"
+27 SET Y=((80-$LENGTH(TMP))\2)+1
+28 SET INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
+29 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+30 SET OFFSET=OFFSET+1
+31 SET @ARRAY@("DISPLAY",OFFSET,0)=""
+32 SET OFFSET=OFFSET+1
+33 SET TMP="Unable to extract Means Test data"
+34 SET Y=((80-$LENGTH(TMP))\2)+1
+35 SET INFO=$$INSERT^VAQUTL1(TMP,"",Y)
+36 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+37 SET OFFSET=OFFSET+1
+38 IF (REASON'="")
Begin DoDot:1
+39 SET REASON="("_REASON_")"
+40 SET Y=((80-$LENGTH(REASON))\2)+1
+41 SET INFO=$$INSERT^VAQUTL1(REASON,"",Y)
+42 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
+43 SET OFFSET=OFFSET+1
End DoDot:1
+44 FOR Y=1:1:2
SET @ARRAY@("DISPLAY",OFFSET,0)=""
SET OFFSET=OFFSET+1
+45 ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
+46 if (TRAN)
SET TMP=$$TRANENC^VAQUTL3(TRAN,0)
+47 if ('TRAN)
SET TMP=$$NCRYPTON^VAQUTL2(0)
+48 if (TMP)
SET TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
+49 QUIT (OFFSET-LINES)
