VAQUPD2 ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-1993
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
TRNDSP(TRANPTR,ROOT,OFFSET) ;BUILD DISPLAY FOR ALL SEGMENTS IN A TRANSACTION
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
; ROOT - Where to store the information (full global reference)
; Defaluts to ^TMP("VAQ",$J)
; OFFSET - Where to begin placing information (defaults to 0)
;OUTPUT : N - Number of lines in display
; -1^Error_Text - Error
;NOTES : ROOT will be returned in the format
; ROOT("DISPLAY",Line_Number,0)
; : Deletion of the outupt array before calling this routine
; is the responsiblity of the calling application.
;
;CHECK INPUT
S TRANPTR=+$G(TRANPTR)
Q:('TRANPTR) "-1^Pointer to VAQ - TRANSACTION file not passed"
Q:('$D(^VAT(394.61,TRANPTR))) "-1^Transaction did not exist"
S ROOT=$G(ROOT)
S:(ROOT="") ROOT="^TMP(""VAQ"","_$J_")"
S OFFSET=+$G(OFFSET)
;DECLARE VARIABLES
N SEG,LINE,LINECNT,X
S LINE=OFFSET
Q:('$D(^VAT(394.61,TRANPTR,"SEG"))) "-1^Transaction did not contain any data segments"
S SEG=0
;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
F S SEG=+$O(^VAT(394.61,TRANPTR,"SEG","B",SEG)) Q:('SEG) D
.;PUT DISPLAY INTO OUTPUT ARRAY
.S LINECNT=$$BLDDSP(TRANPTR,SEG,ROOT,LINE)
.Q:(LINECNT<1)
.S LINE=LINE+LINECNT
.;PUT WHITE SPACE AFTER EACH SEGMENT
.F X=1:1:3 S @ROOT@("DISPLAY",LINE,0)="",LINE=LINE+1
Q (LINE-OFFSET)
;
BLDDSP(TRAN,SEGPTR,ROOT,OFFSET) ;BUILD DISPLAYABLE SEGMENT FROM DATA FILE
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; SEGPTR - Pointer to VAQ - DATA SEGMENT file
; ROOT - Where to store the display array (full global ref)
; OFFSET - Where to begin placing information (defaults to 0)
;OUTPUT : n - Number of lines in display
; -1^Error_Text - Error
;NOTES : ROOT will contain the display ready segment in the format
; ROOT("DISPLAY",LineNumber,0)=Line of display
; : It is the responsibility of the calling module to delete
; ROOT before and after the call.
;
;CHECK INPUT
S TRAN=+$G(TRAN)
S SEGPTR=+$G(SEGPTR)
Q:(('TRAN)!('SEGPTR)) "-1^Did not pass pointer to transaction or segment"
S OFFSET=+$G(OFFSET)
Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid transaction"
Q:('$D(^VAT(394.71,SEGPTR))) "-1^Did not pass a valid segment"
Q:($G(ROOT)="") "-1^Did not pass reference to output array"
;DECLARE VARIABLES
N TMP,XTRCT,MTHD,MINPTR,GETMIN
S XTRCT="^TMP(""VAQ-SEG"","_$J_","_TRAN_","_SEGPTR_")"
K @XTRCT
;SEGMENT NOT PASSED IN PDX
Q:('$D(^VAT(394.62,"A-SEGMENT",TRAN,SEGPTR))) "-1^Transaction did not contain information for segment"
;DISPLAY READY
S TMP=$D(^VAT(394.62,"A-DISPLAY",TRAN,SEGPTR))
Q:(TMP) $$EXTARR^VAQUPD25(TRAN,SEGPTR,ROOT,OFFSET)
;GET METHOD TO BUILD DISPLAY ARRAY
S MTHD=$G(^VAT(394.71,SEGPTR,"DRTN"))
Q:(MTHD="") "-1^Display method did not exist for segment"
;GET EXTRACTION ARRAY
S TMP=$$EXTARR^VAQUPD25(TRAN,SEGPTR,XTRCT)
I (TMP) K @XTRCT Q TMP
;DETERMINE IF MINIMUM DATA NEEDS TO BE PLACED IN EXTRACTION ARRAY
; THIS IS DONE FOR INFO FROM A 1.0 SITE
S TMP=$P($G(^VAT(394.71,SEGPTR,0)),"^",2)
S GETMIN=$S((TMP="PDX*MPL"):1,(TMP="PDX*MPS"):1,1:0)
I ((GETMIN)&((+$P($G(^VAT(394.61,TRAN,0)),"^",7))=1)) D I (TMP) K @XTRCT Q TMP
.;GET POINTER TO MINIMUM SEGMENT
.S MINPTR=+$O(^VAT(394.71,"C","PDX*MIN",""))
.I ('MINPTR) S TMP="-1^Version 1.0 transaction did not contain minimum patient information" Q
.;MIN SEGMENT NOT PASSED IN PDX
.I ('$D(^VAT(394.62,"A-SEGMENT",TRAN,MINPTR))) S TMP="-1^Version 1.0 transaction did not contain minimum patient information" Q
.;PUT MINIMUM DATA INTO EXTRACTION ARRAY
.S TMP=$$EXTARR^VAQUPD25(TRAN,MINPTR,XTRCT)
.S:(TMP) TMP="-1^Unable to extract minimum patient information from version 1.0 transaction"
;BUILD DISPLAY
X ("S TMP="_MTHD)
K @XTRCT
Q TMP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUPD2 3978 printed Sep 23, 2025@20:02:33 Page 2
VAQUPD2 ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-1993
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
TRNDSP(TRANPTR,ROOT,OFFSET) ;BUILD DISPLAY FOR ALL SEGMENTS IN A TRANSACTION
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION file
+2 ; ROOT - Where to store the information (full global reference)
+3 ; Defaluts to ^TMP("VAQ",$J)
+4 ; OFFSET - Where to begin placing information (defaults to 0)
+5 ;OUTPUT : N - Number of lines in display
+6 ; -1^Error_Text - Error
+7 ;NOTES : ROOT will be returned in the format
+8 ; ROOT("DISPLAY",Line_Number,0)
+9 ; : Deletion of the outupt array before calling this routine
+10 ; is the responsiblity of the calling application.
+11 ;
+12 ;CHECK INPUT
+13 SET TRANPTR=+$GET(TRANPTR)
+14 if ('TRANPTR)
QUIT "-1^Pointer to VAQ - TRANSACTION file not passed"
+15 if ('$DATA(^VAT(394.61,TRANPTR)))
QUIT "-1^Transaction did not exist"
+16 SET ROOT=$GET(ROOT)
+17 if (ROOT="")
SET ROOT="^TMP(""VAQ"","_$JOB_")"
+18 SET OFFSET=+$GET(OFFSET)
+19 ;DECLARE VARIABLES
+20 NEW SEG,LINE,LINECNT,X
+21 SET LINE=OFFSET
+22 if ('$DATA(^VAT(394.61,TRANPTR,"SEG")))
QUIT "-1^Transaction did not contain any data segments"
+23 SET SEG=0
+24 ;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
+25 FOR
SET SEG=+$ORDER(^VAT(394.61,TRANPTR,"SEG","B",SEG))
if ('SEG)
QUIT
Begin DoDot:1
+26 ;PUT DISPLAY INTO OUTPUT ARRAY
+27 SET LINECNT=$$BLDDSP(TRANPTR,SEG,ROOT,LINE)
+28 if (LINECNT<1)
QUIT
+29 SET LINE=LINE+LINECNT
+30 ;PUT WHITE SPACE AFTER EACH SEGMENT
+31 FOR X=1:1:3
SET @ROOT@("DISPLAY",LINE,0)=""
SET LINE=LINE+1
End DoDot:1
+32 QUIT (LINE-OFFSET)
+33 ;
BLDDSP(TRAN,SEGPTR,ROOT,OFFSET) ;BUILD DISPLAYABLE SEGMENT FROM DATA FILE
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; SEGPTR - Pointer to VAQ - DATA SEGMENT file
+3 ; ROOT - Where to store the display array (full global ref)
+4 ; OFFSET - Where to begin placing information (defaults to 0)
+5 ;OUTPUT : n - Number of lines in display
+6 ; -1^Error_Text - Error
+7 ;NOTES : ROOT will contain the display ready segment in the format
+8 ; ROOT("DISPLAY",LineNumber,0)=Line of display
+9 ; : It is the responsibility of the calling module to delete
+10 ; ROOT before and after the call.
+11 ;
+12 ;CHECK INPUT
+13 SET TRAN=+$GET(TRAN)
+14 SET SEGPTR=+$GET(SEGPTR)
+15 if (('TRAN)!('SEGPTR))
QUIT "-1^Did not pass pointer to transaction or segment"
+16 SET OFFSET=+$GET(OFFSET)
+17 if ('$DATA(^VAT(394.61,TRAN)))
QUIT "-1^Did not pass valid transaction"
+18 if ('$DATA(^VAT(394.71,SEGPTR)))
QUIT "-1^Did not pass a valid segment"
+19 if ($GET(ROOT)="")
QUIT "-1^Did not pass reference to output array"
+20 ;DECLARE VARIABLES
+21 NEW TMP,XTRCT,MTHD,MINPTR,GETMIN
+22 SET XTRCT="^TMP(""VAQ-SEG"","_$JOB_","_TRAN_","_SEGPTR_")"
+23 KILL @XTRCT
+24 ;SEGMENT NOT PASSED IN PDX
+25 if ('$DATA(^VAT(394.62,"A-SEGMENT",TRAN,SEGPTR)))
QUIT "-1^Transaction did not contain information for segment"
+26 ;DISPLAY READY
+27 SET TMP=$DATA(^VAT(394.62,"A-DISPLAY",TRAN,SEGPTR))
+28 if (TMP)
QUIT $$EXTARR^VAQUPD25(TRAN,SEGPTR,ROOT,OFFSET)
+29 ;GET METHOD TO BUILD DISPLAY ARRAY
+30 SET MTHD=$GET(^VAT(394.71,SEGPTR,"DRTN"))
+31 if (MTHD="")
QUIT "-1^Display method did not exist for segment"
+32 ;GET EXTRACTION ARRAY
+33 SET TMP=$$EXTARR^VAQUPD25(TRAN,SEGPTR,XTRCT)
+34 IF (TMP)
KILL @XTRCT
QUIT TMP
+35 ;DETERMINE IF MINIMUM DATA NEEDS TO BE PLACED IN EXTRACTION ARRAY
+36 ; THIS IS DONE FOR INFO FROM A 1.0 SITE
+37 SET TMP=$PIECE($GET(^VAT(394.71,SEGPTR,0)),"^",2)
+38 SET GETMIN=$SELECT((TMP="PDX*MPL"):1,(TMP="PDX*MPS"):1,1:0)
+39 IF ((GETMIN)&((+$PIECE($GET(^VAT(394.61,TRAN,0)),"^",7))=1))
Begin DoDot:1
+40 ;GET POINTER TO MINIMUM SEGMENT
+41 SET MINPTR=+$ORDER(^VAT(394.71,"C","PDX*MIN",""))
+42 IF ('MINPTR)
SET TMP="-1^Version 1.0 transaction did not contain minimum patient information"
QUIT
+43 ;MIN SEGMENT NOT PASSED IN PDX
+44 IF ('$DATA(^VAT(394.62,"A-SEGMENT",TRAN,MINPTR)))
SET TMP="-1^Version 1.0 transaction did not contain minimum patient information"
QUIT
+45 ;PUT MINIMUM DATA INTO EXTRACTION ARRAY
+46 SET TMP=$$EXTARR^VAQUPD25(TRAN,MINPTR,XTRCT)
+47 if (TMP)
SET TMP="-1^Unable to extract minimum patient information from version 1.0 transaction"
End DoDot:1
IF (TMP)
KILL @XTRCT
QUIT TMP
+48 ;BUILD DISPLAY
+49 XECUTE ("S TMP="_MTHD)
+50 KILL @XTRCT
+51 QUIT TMP
