VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; DFN - Pointer to patient in PATIENT file
; SEGMENT - Pointer to segment in VAQ - DATA SEGMENT file
; ARRAY - Where to store information (full global reference)
; OFFSET - Where to start adding lines (defaults to 0)
; Only used for Display Ready extract
;OUTPUT : n - Number of lines in display
; -1^Error_Text - Error
;NOTES : 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
;
;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(SEGMENT)) "-1^Did not pass pointer to VAQ - DATA SEGMENT FILE"
Q:($G(ARRAY)="") "-1^Did not pass output array"
S OFFSET=+$G(OFFSET)
;DECLARE VARIABLES
N TMP,SEG
;GET SEGMENT ABBREVIATION
S SEG=$P($G(^VAT(394.71,SEGMENT,0)),"^",2)
Q:(SEG="") "-1^Segment pointer not valid"
;MEANS TEST SEGMENT
Q:(SEG="PDX*MT") $$EXTRACT^VAQDBIM(TRAN,DFN,ARRAY,OFFSET)
;PDX MINIMUM PATIENT INFO SEGMENT
Q:(SEG="PDX*MIN") $$MINXTRCT^VAQDBIP3(TRAN,DFN,ARRAY)
;PDX MEDICATION PROFILE (LONG) INFO SEGMENT
Q:(SEG="PDX*MPL") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
;PDX MEDICATION PROFILE (SHORT) INFO SEGMENT
Q:(SEG="PDX*MPS") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
;PDX MAS (REGISTRATION) INFO SEGMENT
Q:(SEG="PDX*MAS") $$MASXTRCT^VAQDBIP4(TRAN,DFN,ARRAY)
;SEGMENT NOT EXTRACTED BY THIS ROUTINE
Q "-1^Extraction of segment not supported"
;
GETSEQ(ARR,FLE,FLD) ;GET NEXT SEQUENCE NUMBER
;INPUT : ARR - Where information is being stored (full global ref)
; FLE - File [number] containing information
; FLD - Field [number] where data is stored
;OUTPUT : Next sequence number in extraction array
;
N SEQ
F SEQ=0:1 Q:('$D(@ARR@("VALUE",FLE,FLD,SEQ)))
Q SEQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIP 2587 printed Sep 23, 2025@20:00:47 Page 2
VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; DFN - Pointer to patient in PATIENT file
+3 ; SEGMENT - Pointer to segment in VAQ - DATA SEGMENT file
+4 ; ARRAY - Where to store information (full global reference)
+5 ; OFFSET - Where to start adding lines (defaults to 0)
+6 ; Only used for Display Ready extract
+7 ;OUTPUT : n - Number of lines in display
+8 ; -1^Error_Text - Error
+9 ;NOTES : If TRAN is passed
+10 ; The patient pointer of the transaction will be used
+11 ; Encryption will be based on the transaction
+12 ; If DFN is passed
+13 ; Encryption will be based on the site parameter
+14 ; : Pointer to transaction takes precedence over DFN ... if
+15 ; TRAN>0 the DFN will be based on the transaction
+16 ;
+17 ;CHECK INPUT
+18 SET TRAN=+$GET(TRAN)
+19 SET DFN=+$GET(DFN)
+20 if (('TRAN)&('DFN))
QUIT "-1^Did not pass pointer to transaction or patient"
+21 IF (TRAN)
if ('$DATA(^VAT(394.61,TRAN)))
QUIT "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
+22 IF (TRAN)
SET DFN=+$PIECE($GET(^VAT(394.61,TRAN,0)),"^",3)
if ('DFN)
QUIT "-1^Transaction did not contain pointer to PATIENT file"
+23 if ('$DATA(^DPT(DFN)))
QUIT "-1^Did not pass valid pointer to PATIENT file"
+24 if ('$GET(SEGMENT))
QUIT "-1^Did not pass pointer to VAQ - DATA SEGMENT FILE"
+25 if ($GET(ARRAY)="")
QUIT "-1^Did not pass output array"
+26 SET OFFSET=+$GET(OFFSET)
+27 ;DECLARE VARIABLES
+28 NEW TMP,SEG
+29 ;GET SEGMENT ABBREVIATION
+30 SET SEG=$PIECE($GET(^VAT(394.71,SEGMENT,0)),"^",2)
+31 if (SEG="")
QUIT "-1^Segment pointer not valid"
+32 ;MEANS TEST SEGMENT
+33 if (SEG="PDX*MT")
QUIT $$EXTRACT^VAQDBIM(TRAN,DFN,ARRAY,OFFSET)
+34 ;PDX MINIMUM PATIENT INFO SEGMENT
+35 if (SEG="PDX*MIN")
QUIT $$MINXTRCT^VAQDBIP3(TRAN,DFN,ARRAY)
+36 ;PDX MEDICATION PROFILE (LONG) INFO SEGMENT
+37 if (SEG="PDX*MPL")
QUIT $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
+38 ;PDX MEDICATION PROFILE (SHORT) INFO SEGMENT
+39 if (SEG="PDX*MPS")
QUIT $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
+40 ;PDX MAS (REGISTRATION) INFO SEGMENT
+41 if (SEG="PDX*MAS")
QUIT $$MASXTRCT^VAQDBIP4(TRAN,DFN,ARRAY)
+42 ;SEGMENT NOT EXTRACTED BY THIS ROUTINE
+43 QUIT "-1^Extraction of segment not supported"
+44 ;
GETSEQ(ARR,FLE,FLD) ;GET NEXT SEQUENCE NUMBER
+1 ;INPUT : ARR - Where information is being stored (full global ref)
+2 ; FLE - File [number] containing information
+3 ; FLD - Field [number] where data is stored
+4 ;OUTPUT : Next sequence number in extraction array
+5 ;
+6 NEW SEQ
+7 FOR SEQ=0:1
if ('$DATA(@ARR@("VALUE",FLE,FLD,SEQ)))
QUIT
+8 QUIT SEQ
