source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBI.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1VAQDBI ;ALB/JRP - EXTRACT DATA SEGMENTS ;22-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EXTRACT(TRANPTR,ROOT) ;EXTRACT DATA SEGMENTS CONTAINED IN A PDX TRANSACTION
4 ;INPUT : TRANPTR - Pointer to VAQ - TRANSACTION FILE
5 ; ROOT - Where to store the information (full global reference)
6 ; Defaults to ^TMP("VAQ",$J)
7 ;OUTPUT : 0 - Success
8 ; -1^Error_Text - Error
9 ;NOTES : Segments returning Extraction Arrays will be stored in
10 ; ROOT(Segment_Abbreviation,"VALUE",File,Field,Sequence_Number)
11 ; ROOT(Segment_Abbreviation,"ID",File,Field,Sequence_Number)
12 ; Segments returning Display Arrays will be stored in
13 ; ROOT(Segment_Abbreviation,"DISPLAY",Line_Number,0)
14 ; : Deletion of the output array before calling this routine
15 ; is the responsibility of the calling application.
16 ;
17 ;CHECK INPUT
18 S TRANPTR=+$G(TRANPTR)
19 Q:('TRANPTR) "-1^Pointer to VAQ - TRANSACTION file not passed"
20 Q:('$D(^VAT(394.61,TRANPTR))) "-1^Transaction did not exist"
21 S ROOT=$G(ROOT)
22 S:(ROOT="") ROOT="^TMP(""VAQ"","_$J_")"
23 ;DECLARE VARIABLES
24 N SEGABB,ERROR,X,SEG,TMP,Y,TMPROOT,PATPTR
25 ;CHECK RELEASE STATUS
26 S TMP=+$P($G(^VAT(394.61,TRANPTR,0)),"^",5)
27 Q:('TMP) "-1^Transaction has not been processed yet"
28 S X=$P($G(^VAT(394.85,TMP,0)),"^",1)
29 ;RELEASE STATUS DOES NOT REQUIRE EXTRACTION OF DATA
30 Q:((X'="VAQ-RSLT")&(X'="VAQ-UNSOL")) 0
31 Q:('$D(^VAT(394.61,TRANPTR,"SEG"))) "-1^Transaction did not contain any data segments"
32 ;GET POINTER TO PATIENT FILE
33 S PATPTR=+$P($G(^VAT(394.61,TRANPTR,0)),"^",3)
34 Q:('PATPTR) "-1^Transaction did not contain pointer to PATIENT file"
35 S ERROR=0
36 S SEG=""
37 ;LOOP THROUGH EACH DATA SEGMENT CONTAINED IN TRANSACTION
38 F D Q:((ERROR)!('SEG))
39 .S SEG=$O(^VAT(394.61,TRANPTR,"SEG","B",SEG))
40 .Q:('SEG)
41 .;GET SEGMENT ABBREVIATION
42 .S SEGABB=$P($G(^VAT(394.71,SEG,0)),"^",2)
43 .Q:(SEGABB="")
44 .;MAKE SEGMENT ABBREVIATION NEXT SUBSCRIPT IN ROOT
45 .S TMP=$P(ROOT,"(",1)
46 .S X=$P(ROOT,"(",2)
47 .S Y=$P(X,")",1)
48 .S:(Y="") TMPROOT=TMP_"("_$C(34)_SEGABB_$C(34)_")"
49 .S:(Y'="") TMPROOT=TMP_"("_Y_","_$C(34)_SEGABB_$C(34)_")"
50 .S X=$$SEGXTRCT(TRANPTR,PATPTR,TMPROOT,SEG)
51 Q 0
52SEGXTRCT(TRAN,DFN,ROOT,SEGPTR,OFFSET) ;EXTRACT A DATA SEGMENT
53 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
54 ; DFN - Pointer to PATIENT file (who to extract)
55 ; ROOT - Where to store the information (full global reference)
56 ; SEGPTR - Pointer to VAQ - DATA SEGMENT file (what to extract)
57 ; OFFSET - Where to begin inserting lines (defaults to 0)
58 ; Only used for Display Arrays
59 ;OUTPUT : 0 - Success (Extraction Array)
60 ; n - Success; number of lines in display (Display Array)
61 ; -1^Error_Text - Error
62 ; : If TRAN is passed
63 ; The patient pointer of the transaction will be used
64 ; Encryption will be based on the transaction
65 ; Time & Occurrence limits will be based on the transaction
66 ; If DFN is passed
67 ; Encryption will be based on the site parameter
68 ; Time & Occurrence limits will be based on the site parameter
69 ; : Pointer to transaction takes precedence over DFN ... if
70 ; TRAN>0 the DFN will be based on the transaction
71 ;
72 ;CHECK INPUT
73 S TRAN=+$G(TRAN)
74 S DFN=+$G(DFN)
75 Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
76 I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
77 I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
78 Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
79 Q:($G(ROOT)="") "-1^Where to store information not passed"
80 S SEGPTR=+$G(SEGPTR)
81 Q:('SEGPTR) "-1^Pointer to VAQ - DATA SEGMENT file not passed"
82 S OFFSET=+$G(OFFSET)
83 ;DECLARE VARIABLES
84 N X,Y,TIMLIM,OCCLIM,NODE,TMP
85 ;SET TIME & OCCURRENCE LIMITS BASED ON PARAMETER FILE
86 ; DEFAULT TO 1 YEAR & 10 OCCURRENCES IF NOT THERE
87 I ('TRAN) D
88 .S TMP=+$O(^VAT(394.81,0))
89 .I ('TMP) S TIMLIM="1Y",OCCLIM=10 Q
90 .S NODE=$G(^VAT(394.81,TMP,"LIMITS"))
91 .S TIMLIM=$P(NODE,"^",1)
92 .S:(TIMLIM="") TIMLIM="1Y"
93 .S OCCLIM=$P(NODE,"^",2)
94 .S:('OCCLIM) OCCLIM=10
95 ;SET TIME & OCCURRENCE LIMITS BASED ON TRANSACTION
96 I (TRAN) D
97 .S TIMLIM=""
98 .S OCCLIM=""
99 .S TMP=+$O(^VAT(394.61,TRAN,"SEG","B",SEGPTR,""))
100 .I (TMP) D
101 ..S NODE=$G(^VAT(394.61,TRAN,"SEG",TMP,0))
102 ..S TIMLIM=$P(NODE,"^",2)
103 ..S OCCLIM=$P(NODE,"^",3)
104 ;GET EXTRACTION METHOD
105 S Y=$G(^VAT(394.71,SEGPTR,"XRTN"))
106 Q:(Y="") "-1^Could not determine extraction routine"
107 ;EXTRACT INFORMATION
108 X ("S X="_Y)
109 Q X
Note: See TracBrowser for help on using the repository browser.