VAQDBI ;ALB/JRP - EXTRACT DATA SEGMENTS ;22-MAR-93
;;1.5;PATIENT DATA EXCHANGE;**44**;NOV 17, 1993;Build 4
;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION FILE
; ROOT - Where to store the information (full global reference)
; Defaults to ^TMP("VAQ",$J)
;OUTPUT : 0 - Success
; -1^Error_Text - Error
;NOTES : Segments returning Extraction Arrays will be stored in
; ROOT(Segment_Abbreviation,"VALUE",File,Field,Sequence_Number)
; ROOT(Segment_Abbreviation,"ID",File,Field,Sequence_Number)
; Segments returning Display Arrays will be stored in
; ROOT(Segment_Abbreviation,"DISPLAY",Line_Number,0)
; : Deletion of the output array before calling this routine
; is the responsibility 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_")"
;DECLARE VARIABLES
N SEGABB,ERROR,X,SEG,TMP,Y,TMPROOT,PATPTR
;CHECK RELEASE STATUS
S TMP=+$P($G(^VAT(394.61,TRANPTR,0)),"^",5)
Q:('TMP) "-1^Transaction has not been processed yet"
S X=$P($G(^VAT(394.85,TMP,0)),"^",1)
;RELEASE STATUS DOES NOT REQUIRE EXTRACTION OF DATA
Q:((X'="VAQ-RSLT")&(X'="VAQ-UNSOL")) 0
Q:('$D(^VAT(394.61,TRANPTR,"SEG"))) "-1^Transaction did not contain any data segments"
;GET POINTER TO PATIENT FILE
S PATPTR=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
Q:('PATPTR) "-1^Transaction did not contain pointer to PATIENT file"
S ERROR=0
S SEG=""
;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
F D Q:((ERROR)!('SEG))
.S SEG=$O(^VAT(394.61,TRANPTR,"SEG","B",SEG))
.Q:('SEG)
.;GET SEGMENT ABBREVIATION
.S SEGABB=$P($G(^VAT(394.71,SEG,0)),"^",2)
.Q:(SEGABB="")
.;MAKE SEGMENT ABBREVIATION NEXT SUBSCRIPT IN ROOT
.S TMP=$P(ROOT,"(",1)
.S X=$P(ROOT,"(",2)
.S Y=$P(X,")",1)
.S:(Y="") TMPROOT=TMP_"("_$C(34)_SEGABB_$C(34)_")"
.S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEGABB_$C(34)_")"
.S X=$$SEGXTRCT(TRANPTR,PATPTR,TMPROOT,SEG)
Q 0
SEGXTRCT(TRAN,DFN,ROOT,SEGPTR,OFFSET) ;EXTRACT A DATA SEGMENT
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; DFN - Pointer to PATIENT file (who to extract)
; ROOT - Where to store the information (full global reference)
; SEGPTR - Pointer to VAQ - DATA SEGMENT file (what to extract)
; OFFSET - Where to begin inserting lines (defaults to 0)
; Only used for Display Arrays
;OUTPUT : 0 - Success (Extraction Array)
; n - Success; number of lines in display (Display Array)
; -1^Error_Text - Error
; : If TRAN is passed
; The patient pointer of the transaction will be used
; Encryption will be based on the transaction
; Time & Occurrence limits will be based on the transaction
; If DFN is passed
; Encryption will be based on the site parameter
; Time & Occurrence limits 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(ROOT)="") "-1^Where to store information not passed"
S SEGPTR=+$G(SEGPTR)
Q:('SEGPTR) "-1^Pointer to VAQ - DATA SEGMENT file not passed"
S OFFSET=+$G(OFFSET)
;DECLARE VARIABLES
N X,Y,TIMLIM,OCCLIM,NODE,TMP,VAQHSC
;SET TIME & OCCURRENCE LIMITS BASED ON PARAMETER FILE
; DEFAULT TO 1 YEAR & 10 OCCURRENCES IF NOT THERE
I ('TRAN) D
.S TMP=+$O(^VAT(394.81,0))
.I ('TMP) S TIMLIM="1Y",OCCLIM=10 Q
.S NODE=$G(^VAT(394.81,TMP,"LIMITS"))
.S TIMLIM=$P(NODE,"^",1)
.S:(TIMLIM="") TIMLIM="1Y"
.S OCCLIM=$P(NODE,"^",2)
.S:('OCCLIM) OCCLIM=10
;SET TIME & OCCURRENCE LIMITS BASED ON TRANSACTION
I (TRAN) D
.S TIMLIM=""
.S OCCLIM=""
.S TMP=+$O(^VAT(394.61,TRAN,"SEG","B",SEGPTR,""))
.I (TMP) D
..S NODE=$G(^VAT(394.61,TRAN,"SEG",TMP,0))
..S TIMLIM=$P(NODE,"^",2)
..S OCCLIM=$P(NODE,"^",3)
;GET EXTRACTION METHOD
S Y=$G(^VAT(394.71,SEGPTR,"XRTN"))
Q:(Y="") "-1^Could not determine extraction routine"
;VALIDATE HEALTH SUMMARY COMPONENT ICR 814
;RRA VAQ*1.5*44 TICKET 146245
S VAQHSC=$P($G(^VAT(394.71,SEGPTR,0)),"^",4)
I +VAQHSC>0 Q:('$D(^GMT(142.1,VAQHSC,0))) "-1^Invalid pointer to Health Summary Component file"
;EXTRACT INFORMATION
X ("S X="_Y)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBI 4961 printed Apr 09, 2024@21:27 Page 2
VAQDBI ;ALB/JRP - EXTRACT DATA SEGMENTS ;22-MAR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**44**;NOV 17, 1993;Build 4
+1 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION FILE
+2 ; ROOT - Where to store the information (full global reference)
+3 ; Defaults to ^TMP("VAQ",$J)
+4 ;OUTPUT : 0 - Success
+5 ; -1^Error_Text - Error
+6 ;NOTES : Segments returning Extraction Arrays will be stored in
+7 ; ROOT(Segment_Abbreviation,"VALUE",File,Field,Sequence_Number)
+8 ; ROOT(Segment_Abbreviation,"ID",File,Field,Sequence_Number)
+9 ; Segments returning Display Arrays will be stored in
+10 ; ROOT(Segment_Abbreviation,"DISPLAY",Line_Number,0)
+11 ; : Deletion of the output array before calling this routine
+12 ; is the responsibility of the calling application.
+13 ;
+14 ;CHECK INPUT
+15 SET TRANPTR=+$GET(TRANPTR)
+16 if ('TRANPTR)
QUIT "-1^Pointer to VAQ - TRANSACTION file not passed"
+17 if ('$DATA(^VAT(394.61,TRANPTR)))
QUIT "-1^Transaction did not exist"
+18 SET ROOT=$GET(ROOT)
+19 if (ROOT="")
SET ROOT="^TMP(""VAQ"","_$JOB_")"
+20 ;DECLARE VARIABLES
+21 NEW SEGABB,ERROR,X,SEG,TMP,Y,TMPROOT,PATPTR
+22 ;CHECK RELEASE STATUS
+23 SET TMP=+$PIECE($GET(^VAT(394.61,TRANPTR,0)),"^",5)
+24 if ('TMP)
QUIT "-1^Transaction has not been processed yet"
+25 SET X=$PIECE($GET(^VAT(394.85,TMP,0)),"^",1)
+26 ;RELEASE STATUS DOES NOT REQUIRE EXTRACTION OF DATA
+27 if ((X'="VAQ-RSLT")&(X'="VAQ-UNSOL"))
QUIT 0
+28 if ('$DATA(^VAT(394.61,TRANPTR,"SEG")))
QUIT "-1^Transaction did not contain any data segments"
+29 ;GET POINTER TO PATIENT FILE
+30 SET PATPTR=+$PIECE($GET(^VAT(394.61,TRANPTR,0)),"^",3)
+31 if ('PATPTR)
QUIT "-1^Transaction did not contain pointer to PATIENT file"
+32 SET ERROR=0
+33 SET SEG=""
+34 ;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
+35 FOR
Begin DoDot:1
+36 SET SEG=$ORDER(^VAT(394.61,TRANPTR,"SEG","B",SEG))
+37 if ('SEG)
QUIT
+38 ;GET SEGMENT ABBREVIATION
+39 SET SEGABB=$PIECE($GET(^VAT(394.71,SEG,0)),"^",2)
+40 if (SEGABB="")
QUIT
+41 ;MAKE SEGMENT ABBREVIATION NEXT SUBSCRIPT IN ROOT
+42 SET TMP=$PIECE(ROOT,"(",1)
+43 SET X=$PIECE(ROOT,"(",2)
+44 SET Y=$PIECE(X,")",1)
+45 if (Y="")
SET TMPROOT=TMP_"("_$CHAR(34)_SEGABB_$CHAR(34)_")"
+46 if (Y'="")
SET TMPROOT=TMP_"("_Y_","_$CHAR(34)_SEGABB_$CHAR(34)_")"
+47 SET X=$$SEGXTRCT(TRANPTR,PATPTR,TMPROOT,SEG)
End DoDot:1
if ((ERROR)!('SEG))
QUIT
+48 QUIT 0
SEGXTRCT(TRAN,DFN,ROOT,SEGPTR,OFFSET) ;EXTRACT A DATA SEGMENT
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; DFN - Pointer to PATIENT file (who to extract)
+3 ; ROOT - Where to store the information (full global reference)
+4 ; SEGPTR - Pointer to VAQ - DATA SEGMENT file (what to extract)
+5 ; OFFSET - Where to begin inserting lines (defaults to 0)
+6 ; Only used for Display Arrays
+7 ;OUTPUT : 0 - Success (Extraction Array)
+8 ; n - Success; number of lines in display (Display Array)
+9 ; -1^Error_Text - Error
+10 ; : If TRAN is passed
+11 ; The patient pointer of the transaction will be used
+12 ; Encryption will be based on the transaction
+13 ; Time & Occurrence limits will be based on the transaction
+14 ; If DFN is passed
+15 ; Encryption will be based on the site parameter
+16 ; Time & Occurrence limits will be based on the site parameter
+17 ; : Pointer to transaction takes precedence over DFN ... if
+18 ; TRAN>0 the DFN will be based on the transaction
+19 ;
+20 ;CHECK INPUT
+21 SET TRAN=+$GET(TRAN)
+22 SET DFN=+$GET(DFN)
+23 if (('TRAN)&('DFN))
QUIT "-1^Did not pass pointer to transaction or patient"
+24 IF (TRAN)
if ('$DATA(^VAT(394.61,TRAN)))
QUIT "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
+25 IF (TRAN)
SET DFN=+$PIECE($GET(^VAT(394.61,TRAN,0)),"^",3)
if ('DFN)
QUIT "-1^Transaction did not contain pointer to PATIENT file"
+26 if ('$DATA(^DPT(DFN)))
QUIT "-1^Did not pass valid pointer to PATIENT file"
+27 if ($GET(ROOT)="")
QUIT "-1^Where to store information not passed"
+28 SET SEGPTR=+$GET(SEGPTR)
+29 if ('SEGPTR)
QUIT "-1^Pointer to VAQ - DATA SEGMENT file not passed"
+30 SET OFFSET=+$GET(OFFSET)
+31 ;DECLARE VARIABLES
+32 NEW X,Y,TIMLIM,OCCLIM,NODE,TMP,VAQHSC
+33 ;SET TIME & OCCURRENCE LIMITS BASED ON PARAMETER FILE
+34 ; DEFAULT TO 1 YEAR & 10 OCCURRENCES IF NOT THERE
+35 IF ('TRAN)
Begin DoDot:1
+36 SET TMP=+$ORDER(^VAT(394.81,0))
+37 IF ('TMP)
SET TIMLIM="1Y"
SET OCCLIM=10
QUIT
+38 SET NODE=$GET(^VAT(394.81,TMP,"LIMITS"))
+39 SET TIMLIM=$PIECE(NODE,"^",1)
+40 if (TIMLIM="")
SET TIMLIM="1Y"
+41 SET OCCLIM=$PIECE(NODE,"^",2)
+42 if ('OCCLIM)
SET OCCLIM=10
End DoDot:1
+43 ;SET TIME & OCCURRENCE LIMITS BASED ON TRANSACTION
+44 IF (TRAN)
Begin DoDot:1
+45 SET TIMLIM=""
+46 SET OCCLIM=""
+47 SET TMP=+$ORDER(^VAT(394.61,TRAN,"SEG","B",SEGPTR,""))
+48 IF (TMP)
Begin DoDot:2
+49 SET NODE=$GET(^VAT(394.61,TRAN,"SEG",TMP,0))
+50 SET TIMLIM=$PIECE(NODE,"^",2)
+51 SET OCCLIM=$PIECE(NODE,"^",3)
End DoDot:2
End DoDot:1
+52 ;GET EXTRACTION METHOD
+53 SET Y=$GET(^VAT(394.71,SEGPTR,"XRTN"))
+54 if (Y="")
QUIT "-1^Could not determine extraction routine"
+55 ;VALIDATE HEALTH SUMMARY COMPONENT ICR 814
+56 ;RRA VAQ*1.5*44 TICKET 146245
+57 SET VAQHSC=$PIECE($GET(^VAT(394.71,SEGPTR,0)),"^",4)
+58 IF +VAQHSC>0
if ('$DATA(^GMT(142.1,VAQHSC,0)))
QUIT "-1^Invalid pointer to Health Summary Component file"
+59 ;EXTRACT INFORMATION
+60 XECUTE ("S X="_Y)
+61 QUIT X
