| 1 | VAQDBIP ;ALB/JRP - EXTRACTIONS DONE BY PDX;9-MAR-93
 | 
|---|
| 2 |  ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
 | 
|---|
| 3 | EXTRACT(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 |  ;
 | 
|---|
| 48 | GETSEQ(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
 | 
|---|