Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQDBI

VAQDBI.m

Go to the documentation of this file.
  1. VAQDBI ;ALB/JRP - EXTRACT DATA SEGMENTS ;22-MAR-93
  1. ;;1.5;PATIENT DATA EXCHANGE;**44**;NOV 17, 1993;Build 4
  1. EXTRACT(TRANPTR,ROOT) ;EXTRACT DATA SEGMENTS CONTAINED IN A PDX TRANSACTION
  1. ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION FILE
  1. ; ROOT - Where to store the information (full global reference)
  1. ; Defaults to ^TMP("VAQ",$J)
  1. ;OUTPUT : 0 - Success
  1. ; -1^Error_Text - Error
  1. ;NOTES : Segments returning Extraction Arrays will be stored in
  1. ; ROOT(Segment_Abbreviation,"VALUE",File,Field,Sequence_Number)
  1. ; ROOT(Segment_Abbreviation,"ID",File,Field,Sequence_Number)
  1. ; Segments returning Display Arrays will be stored in
  1. ; ROOT(Segment_Abbreviation,"DISPLAY",Line_Number,0)
  1. ; : Deletion of the output array before calling this routine
  1. ; is the responsibility of the calling application.
  1. ;
  1. ;CHECK INPUT
  1. S TRANPTR=+$G(TRANPTR)
  1. Q:('TRANPTR) "-1^Pointer to VAQ - TRANSACTION file not passed"
  1. Q:('$D(^VAT(394.61,TRANPTR))) "-1^Transaction did not exist"
  1. S ROOT=$G(ROOT)
  1. S:(ROOT="") ROOT="^TMP(""VAQ"","_$J_")"
  1. ;DECLARE VARIABLES
  1. N SEGABB,ERROR,X,SEG,TMP,Y,TMPROOT,PATPTR
  1. ;CHECK RELEASE STATUS
  1. S TMP=+$P($G(^VAT(394.61,TRANPTR,0)),"^",5)
  1. Q:('TMP) "-1^Transaction has not been processed yet"
  1. S X=$P($G(^VAT(394.85,TMP,0)),"^",1)
  1. ;RELEASE STATUS DOES NOT REQUIRE EXTRACTION OF DATA
  1. Q:((X'="VAQ-RSLT")&(X'="VAQ-UNSOL")) 0
  1. Q:('$D(^VAT(394.61,TRANPTR,"SEG"))) "-1^Transaction did not contain any data segments"
  1. ;GET POINTER TO PATIENT FILE
  1. S PATPTR=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
  1. Q:('PATPTR) "-1^Transaction did not contain pointer to PATIENT file"
  1. S ERROR=0
  1. S SEG=""
  1. ;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
  1. F D Q:((ERROR)!('SEG))
  1. .S SEG=$O(^VAT(394.61,TRANPTR,"SEG","B",SEG))
  1. .Q:('SEG)
  1. .;GET SEGMENT ABBREVIATION
  1. .S SEGABB=$P($G(^VAT(394.71,SEG,0)),"^",2)
  1. .Q:(SEGABB="")
  1. .;MAKE SEGMENT ABBREVIATION NEXT SUBSCRIPT IN ROOT
  1. .S TMP=$P(ROOT,"(",1)
  1. .S X=$P(ROOT,"(",2)
  1. .S Y=$P(X,")",1)
  1. .S:(Y="") TMPROOT=TMP_"("_$C(34)_SEGABB_$C(34)_")"
  1. .S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEGABB_$C(34)_")"
  1. .S X=$$SEGXTRCT(TRANPTR,PATPTR,TMPROOT,SEG)
  1. Q 0
  1. SEGXTRCT(TRAN,DFN,ROOT,SEGPTR,OFFSET) ;EXTRACT A DATA SEGMENT
  1. ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
  1. ; DFN - Pointer to PATIENT file (who to extract)
  1. ; ROOT - Where to store the information (full global reference)
  1. ; SEGPTR - Pointer to VAQ - DATA SEGMENT file (what to extract)
  1. ; OFFSET - Where to begin inserting lines (defaults to 0)
  1. ; Only used for Display Arrays
  1. ;OUTPUT : 0 - Success (Extraction Array)
  1. ; n - Success; number of lines in display (Display Array)
  1. ; -1^Error_Text - Error
  1. ; : If TRAN is passed
  1. ; The patient pointer of the transaction will be used
  1. ; Encryption will be based on the transaction
  1. ; Time & Occurrence limits will be based on the transaction
  1. ; If DFN is passed
  1. ; Encryption will be based on the site parameter
  1. ; Time & Occurrence limits will be based on the site parameter
  1. ; : Pointer to transaction takes precedence over DFN ... if
  1. ; TRAN>0 the DFN will be based on the transaction
  1. ;
  1. ;CHECK INPUT
  1. S TRAN=+$G(TRAN)
  1. S DFN=+$G(DFN)
  1. Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
  1. I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
  1. I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
  1. Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
  1. Q:($G(ROOT)="") "-1^Where to store information not passed"
  1. S SEGPTR=+$G(SEGPTR)
  1. Q:('SEGPTR) "-1^Pointer to VAQ - DATA SEGMENT file not passed"
  1. S OFFSET=+$G(OFFSET)
  1. ;DECLARE VARIABLES
  1. N X,Y,TIMLIM,OCCLIM,NODE,TMP,VAQHSC
  1. ;SET TIME & OCCURRENCE LIMITS BASED ON PARAMETER FILE
  1. ; DEFAULT TO 1 YEAR & 10 OCCURRENCES IF NOT THERE
  1. I ('TRAN) D
  1. .S TMP=+$O(^VAT(394.81,0))
  1. .I ('TMP) S TIMLIM="1Y",OCCLIM=10 Q
  1. .S NODE=$G(^VAT(394.81,TMP,"LIMITS"))
  1. .S TIMLIM=$P(NODE,"^",1)
  1. .S:(TIMLIM="") TIMLIM="1Y"
  1. .S OCCLIM=$P(NODE,"^",2)
  1. .S:('OCCLIM) OCCLIM=10
  1. ;SET TIME & OCCURRENCE LIMITS BASED ON TRANSACTION
  1. I (TRAN) D
  1. .S TIMLIM=""
  1. .S OCCLIM=""
  1. .S TMP=+$O(^VAT(394.61,TRAN,"SEG","B",SEGPTR,""))
  1. .I (TMP) D
  1. ..S NODE=$G(^VAT(394.61,TRAN,"SEG",TMP,0))
  1. ..S TIMLIM=$P(NODE,"^",2)
  1. ..S OCCLIM=$P(NODE,"^",3)
  1. ;GET EXTRACTION METHOD
  1. S Y=$G(^VAT(394.71,SEGPTR,"XRTN"))
  1. Q:(Y="") "-1^Could not determine extraction routine"
  1. ;VALIDATE HEALTH SUMMARY COMPONENT ICR 814
  1. ;RRA VAQ*1.5*44 TICKET 146245
  1. S VAQHSC=$P($G(^VAT(394.71,SEGPTR,0)),"^",4)
  1. I +VAQHSC>0 Q:('$D(^GMT(142.1,VAQHSC,0))) "-1^Invalid pointer to Health Summary Component file"
  1. ;EXTRACT INFORMATION
  1. X ("S X="_Y)
  1. Q X