- 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 Feb 18, 2025@23:51 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