| 1 | VAQUPD25 ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | EXTARR(TRAN,SEG,ROOT,OFFSET) ;PULL EXTRACTION ARRAY OUT OF DATA FILE
|
|---|
| 4 | ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
|
|---|
| 5 | ; SEG - Pointer to VAQ - DATA SEGMENT file
|
|---|
| 6 | ; ROOT - Where to store the extraction array (full global ref)
|
|---|
| 7 | ; OFFSET - Where to begin placing information (defaults to 0)
|
|---|
| 8 | ; (Only valid for extractions that are in Display
|
|---|
| 9 | ; Ready format)
|
|---|
| 10 | ;OUTPUT : 0 - Success (non-display ready)
|
|---|
| 11 | ; n - Number of lines in display (display ready format)
|
|---|
| 12 | ; -1^Error_Text - Error
|
|---|
| 13 | ;NOTES : If the segment is not in display ready format
|
|---|
| 14 | ; ROOT("VALUE",File,Field,Seq)=Data
|
|---|
| 15 | ; ROOT("ID",File,Field,Seq)=Identifier
|
|---|
| 16 | ; If the segment is in display ready format
|
|---|
| 17 | ; ROOT("DISPLAY",LineNumber,0)=Line of display
|
|---|
| 18 | ;
|
|---|
| 19 | ;CHECK INPUT
|
|---|
| 20 | S TRAN=+$G(TRAN)
|
|---|
| 21 | S SEG=+$G(SEG)
|
|---|
| 22 | Q:(('TRAN)!('SEG)) "-1^Did not pass pointer transaction or segment"
|
|---|
| 23 | S OFFSET=+$G(OFFSET)
|
|---|
| 24 | Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid transaction"
|
|---|
| 25 | Q:('$D(^VAT(394.71,SEG))) "-1^Did not pass a valid segment"
|
|---|
| 26 | Q:($G(ROOT)="") "-1^Did not pass reference to output array"
|
|---|
| 27 | ;DON'T EXTRACT IF PURGE FLAG IS SET
|
|---|
| 28 | Q:($D(^VAT(394.61,"PURGE",1,TRAN))) "-1^Transaction has been flagged for purging"
|
|---|
| 29 | ;DECLARE VARIABLES
|
|---|
| 30 | N LINE,IFN,TMP,SEQ,FILE,FIELD,VALUE,ID,DISPLAY
|
|---|
| 31 | S LINE=OFFSET
|
|---|
| 32 | ;DETERMINE IF SEGMENT HAS DATA
|
|---|
| 33 | Q:('$D(^VAT(394.62,"A-SEGMENT",TRAN,SEG))) "-1^Segment did not contain any data"
|
|---|
| 34 | ;DETERMINE IF SEGMENT IS DISPLAY READY
|
|---|
| 35 | S DISPLAY=$D(^VAT(394.62,"A-DISPLAY",TRAN,SEG))
|
|---|
| 36 | ;DISPLAY READY
|
|---|
| 37 | I (DISPLAY) D Q LINE-OFFSET
|
|---|
| 38 | .;GET IFN (USED FOR DIPSLAY READY)
|
|---|
| 39 | .S IFN=+$O(^VAT(394.62,"A-SEGMENT",TRAN,SEG,""))
|
|---|
| 40 | .Q:('IFN)
|
|---|
| 41 | .S SEQ=0
|
|---|
| 42 | .F S SEQ=$O(^VAT(394.62,IFN,"DSP",SEQ)) Q:('SEQ) D
|
|---|
| 43 | ..S VALUE=$G(^VAT(394.62,IFN,"DSP",SEQ,0))
|
|---|
| 44 | ..S @ROOT@("DISPLAY",LINE,0)=VALUE
|
|---|
| 45 | ..S LINE=LINE+1
|
|---|
| 46 | ;EXTRACTION ARRAY
|
|---|
| 47 | S IFN=""
|
|---|
| 48 | F S IFN=$O(^VAT(394.62,"A-SEGMENT",TRAN,SEG,IFN)) Q:('IFN) D
|
|---|
| 49 | .S TMP=$G(^VAT(394.62,IFN,0))
|
|---|
| 50 | .S FILE=+$P(TMP,"^",3)
|
|---|
| 51 | .Q:('FILE)
|
|---|
| 52 | .S FIELD=+$P(TMP,"^",4)
|
|---|
| 53 | .Q:('FIELD)
|
|---|
| 54 | .S SEQ=+$G(^VAT(394.62,IFN,"SQNCE"))
|
|---|
| 55 | .S VALUE=$G(^VAT(394.62,IFN,"VAL"))
|
|---|
| 56 | .S ID=$G(^VAT(394.62,IFN,"IDNT1"))
|
|---|
| 57 | .S @ROOT@("VALUE",FILE,FIELD,SEQ)=VALUE
|
|---|
| 58 | .S @ROOT@("ID",FILE,FIELD,SEQ)=ID
|
|---|
| 59 | Q 0
|
|---|
