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