source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EXTRACT(TRAN,DFN,SEGMENT,ARRAY,OFFSET) ;EXTRACTIONS BY PDX
4 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
5 ; DFN - Pointer to patient in PATIENT file
6 ; SEGMENT - Pointer to segment in VAQ - DATA SEGMENT file
7 ; ARRAY - Where to store information (full global reference)
8 ; OFFSET - Where to start adding lines (defaults to 0)
9 ; Only used for Display Ready extract
10 ;OUTPUT : n - Number of lines in display
11 ; -1^Error_Text - Error
12 ;NOTES : If TRAN is passed
13 ; The patient pointer of the transaction will be used
14 ; Encryption will be based on the transaction
15 ; If DFN is passed
16 ; Encryption 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 S TRAN=+$G(TRAN)
22 S DFN=+$G(DFN)
23 Q:(('TRAN)&('DFN)) "-1^Did not pass pointer to transaction or patient"
24 I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
25 I (TRAN) S DFN=+$P($G(^VAT(394.61,TRAN,0)),"^",3) Q:('DFN) "-1^Transaction did not contain pointer to PATIENT file"
26 Q:('$D(^DPT(DFN))) "-1^Did not pass valid pointer to PATIENT file"
27 Q:('$G(SEGMENT)) "-1^Did not pass pointer to VAQ - DATA SEGMENT FILE"
28 Q:($G(ARRAY)="") "-1^Did not pass output array"
29 S OFFSET=+$G(OFFSET)
30 ;DECLARE VARIABLES
31 N TMP,SEG
32 ;GET SEGMENT ABBREVIATION
33 S SEG=$P($G(^VAT(394.71,SEGMENT,0)),"^",2)
34 Q:(SEG="") "-1^Segment pointer not valid"
35 ;MEANS TEST SEGMENT
36 Q:(SEG="PDX*MT") $$EXTRACT^VAQDBIM(TRAN,DFN,ARRAY,OFFSET)
37 ;PDX MINIMUM PATIENT INFO SEGMENT
38 Q:(SEG="PDX*MIN") $$MINXTRCT^VAQDBIP3(TRAN,DFN,ARRAY)
39 ;PDX MEDICATION PROFILE (LONG) INFO SEGMENT
40 Q:(SEG="PDX*MPL") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
41 ;PDX MEDICATION PROFILE (SHORT) INFO SEGMENT
42 Q:(SEG="PDX*MPS") $$RXXTRCT^VAQDBIP1(TRAN,DFN,ARRAY)
43 ;PDX MAS (REGISTRATION) INFO SEGMENT
44 Q:(SEG="PDX*MAS") $$MASXTRCT^VAQDBIP4(TRAN,DFN,ARRAY)
45 ;SEGMENT NOT EXTRACTED BY THIS ROUTINE
46 Q "-1^Extraction of segment not supported"
47 ;
48GETSEQ(ARR,FLE,FLD) ;GET NEXT SEQUENCE NUMBER
49 ;INPUT : ARR - Where information is being stored (full global ref)
50 ; FLE - File [number] containing information
51 ; FLD - Field [number] where data is stored
52 ;OUTPUT : Next sequence number in extraction array
53 ;
54 N SEQ
55 F SEQ=0:1 Q:('$D(@ARR@("VALUE",FLE,FLD,SEQ)))
56 Q SEQ
Note: See TracBrowser for help on using the repository browser.