| [613] | 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 | 
|---|