VAQDBIM ;ALB/JRP - MEANS TEST EXTRACTION;1-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.
; **********
;
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; DFN - Pointer to patient in PATIENT file
; ARRAY - Where to store information (full global reference)
; OFFSET - Where to start adding lines (defaults to 0)
;OUTPUT : n - Number of lines in display
; -1^Error_text - Error
;NOTE : If TRAN is passed
; The patient pointer of the transaction will be used
; Encryption will be based on the transaction
; If DFN is passed
; Encryption will be based on the site parameter
; : Pointer to transaction takes precedence over DFN ... if
; TRAN>0 the DFN will be based on the transaction
;
;This module is not based on any single DGMTSC* routine. Setting
;up of information required to extract Means Test information was
;drawn from several routines/utilitities.
;
;CHECK INPUT
S TRAN=+$G(TRAN)
S DFN=+$G(DFN)
Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
Q:($G(ARRAY)="") "-1^Did not pass output array"
S OFFSET=+$G(OFFSET)
;DECLARE VARIABLES
N DGMTDT,DGMTSC,DGVPRI,DGVINI,DGVIRI,DGMTPAR,DGERR,DGFL,DGDEP
N DGMTYPT,DGMTI,LINES,TMP,VAQMT
;SAVE STARTING OFFSET
S LINES=OFFSET
;SET MEANS TEST TYPE
S DGMTYPT=1
;GET DATE OF LAST MEANS TEST
S VAQMT=$$LST^DGMTU(DFN)
S DGMTI=$P(VAQMT,U,1),DGMTDT=$P(VAQMT,U,2)
Q:(DGMTDT="") $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,"Could not determine date of last Means Test")
;SET UP MEANS TEST VARIABLES
D SETUP^DGMTSCU
Q:(DGERR) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,"Unable to set up Means Test variables")
;PUT IN TITLE
S TMP=$$TITLE^VAQDBIM0(ARRAY,OFFSET)
Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
S OFFSET=OFFSET+TMP
;EXTRACT SCREEN 1
S TMP=$$XTRCT1^VAQDBIM1(DFN,ARRAY,OFFSET)
Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
S OFFSET=OFFSET+TMP
F TMP=1:1:3 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
;EXTRACT SCREEN 2
S TMP=$$XTRCT2^VAQDBIM2(DFN,ARRAY,OFFSET)
Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
S OFFSET=OFFSET+TMP
F TMP=1:1:3 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
;EXTRACT SCREEN 3
S TMP=$$XTRCT3^VAQDBIM3(DFN,ARRAY,OFFSET)
Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
S OFFSET=OFFSET+TMP
F TMP=1:1:3 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
;EXTRACT SCREEN 4
S TMP=$$XTRCT4^VAQDBIM4(DFN,ARRAY,OFFSET)
Q:(TMP<0) $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$P(TMP,"^",2))
S OFFSET=OFFSET+TMP
F TMP=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))
;RETURN NUMBER OF LINES IN DISPLAY
Q (OFFSET-LINES)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM 3524 printed Sep 23, 2025@20:00:41 Page 2
VAQDBIM ;ALB/JRP - MEANS TEST EXTRACTION;1-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 ;
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; DFN - Pointer to patient in PATIENT file
+3 ; ARRAY - Where to store information (full global reference)
+4 ; OFFSET - Where to start adding lines (defaults to 0)
+5 ;OUTPUT : n - Number of lines in display
+6 ; -1^Error_text - Error
+7 ;NOTE : If TRAN is passed
+8 ; The patient pointer of the transaction will be used
+9 ; Encryption will be based on the transaction
+10 ; If DFN is passed
+11 ; Encryption will be based on the site parameter
+12 ; : Pointer to transaction takes precedence over DFN ... if
+13 ; TRAN>0 the DFN will be based on the transaction
+14 ;
+15 ;This module is not based on any single DGMTSC* routine. Setting
+16 ;up of information required to extract Means Test information was
+17 ;drawn from several routines/utilitities.
+18 ;
+19 ;CHECK INPUT
+20 SET TRAN=+$GET(TRAN)
+21 SET DFN=+$GET(DFN)
+22 if (('TRAN)&('DFN))
QUIT "-1^Did not pass pointer to transaction or patient"
+23 IF (TRAN)
if ('$DATA(^VAT(394.61,TRAN)))
QUIT "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
+24 IF (TRAN)
SET DFN=+$PIECE($GET(^VAT(394.61,TRAN,0)),"^",3)
if ('DFN)
QUIT "-1^Transaction did not contain pointer to PATIENT file"
+25 if ('$DATA(^DPT(DFN)))
QUIT "-1^Did not pass valid pointer to PATIENT file"
+26 if ($GET(ARRAY)="")
QUIT "-1^Did not pass output array"
+27 SET OFFSET=+$GET(OFFSET)
+28 ;DECLARE VARIABLES
+29 NEW DGMTDT,DGMTSC,DGVPRI,DGVINI,DGVIRI,DGMTPAR,DGERR,DGFL,DGDEP
+30 NEW DGMTYPT,DGMTI,LINES,TMP,VAQMT
+31 ;SAVE STARTING OFFSET
+32 SET LINES=OFFSET
+33 ;SET MEANS TEST TYPE
+34 SET DGMTYPT=1
+35 ;GET DATE OF LAST MEANS TEST
+36 SET VAQMT=$$LST^DGMTU(DFN)
+37 SET DGMTI=$PIECE(VAQMT,U,1)
SET DGMTDT=$PIECE(VAQMT,U,2)
+38 if (DGMTDT="")
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,"Could not determine date of last Means Test")
+39 ;SET UP MEANS TEST VARIABLES
+40 DO SETUP^DGMTSCU
+41 if (DGERR)
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,"Unable to set up Means Test variables")
+42 ;PUT IN TITLE
+43 SET TMP=$$TITLE^VAQDBIM0(ARRAY,OFFSET)
+44 if (TMP<0)
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$PIECE(TMP,"^",2))
+45 SET OFFSET=OFFSET+TMP
+46 ;EXTRACT SCREEN 1
+47 SET TMP=$$XTRCT1^VAQDBIM1(DFN,ARRAY,OFFSET)
+48 if (TMP<0)
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$PIECE(TMP,"^",2))
+49 SET OFFSET=OFFSET+TMP
+50 FOR TMP=1:1:3
SET @ARRAY@("DISPLAY",OFFSET,0)=""
SET OFFSET=OFFSET+1
+51 ;EXTRACT SCREEN 2
+52 SET TMP=$$XTRCT2^VAQDBIM2(DFN,ARRAY,OFFSET)
+53 if (TMP<0)
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$PIECE(TMP,"^",2))
+54 SET OFFSET=OFFSET+TMP
+55 FOR TMP=1:1:3
SET @ARRAY@("DISPLAY",OFFSET,0)=""
SET OFFSET=OFFSET+1
+56 ;EXTRACT SCREEN 3
+57 SET TMP=$$XTRCT3^VAQDBIM3(DFN,ARRAY,OFFSET)
+58 if (TMP<0)
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$PIECE(TMP,"^",2))
+59 SET OFFSET=OFFSET+TMP
+60 FOR TMP=1:1:3
SET @ARRAY@("DISPLAY",OFFSET,0)=""
SET OFFSET=OFFSET+1
+61 ;EXTRACT SCREEN 4
+62 SET TMP=$$XTRCT4^VAQDBIM4(DFN,ARRAY,OFFSET)
+63 if (TMP<0)
QUIT $$ERROR^VAQDBIM0(TRAN,ARRAY,LINES,$PIECE(TMP,"^",2))
+64 SET OFFSET=OFFSET+TMP
+65 FOR TMP=1:1:2
SET @ARRAY@("DISPLAY",OFFSET,0)=""
SET OFFSET=OFFSET+1
+66 ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
+67 if (TRAN)
SET TMP=$$TRANENC^VAQUTL3(TRAN,0)
+68 if ('TRAN)
SET TMP=$$NCRYPTON^VAQUTL2(0)
+69 if (TMP)
SET TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
+70 ;RETURN NUMBER OF LINES IN DISPLAY
+71 QUIT (OFFSET-LINES)
