60 lines
2.3 KiB
Mathematica
60 lines
2.3 KiB
Mathematica
|
VAQUPD25 ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-93
|
||
|
|
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
||
|
|
EXTARR(TRAN,SEG,ROOT,OFFSET) ;PULL EXTRACTION ARRAY OUT OF DATA FILE
|
||
|
|
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
|
||
|
|
; SEG - Pointer to VAQ - DATA SEGMENT file
|
||
|
|
; ROOT - Where to store the extraction array (full global ref)
|
||
|
|
; OFFSET - Where to begin placing information (defaults to 0)
|
||
|
|
; (Only valid for extractions that are in Display
|
||
|
|
; Ready format)
|
||
|
|
;OUTPUT : 0 - Success (non-display ready)
|
||
|
|
; n - Number of lines in display (display ready format)
|
||
|
|
; -1^Error_Text - Error
|
||
|
|
;NOTES : If the segment is not in display ready format
|
||
|
|
; ROOT("VALUE",File,Field,Seq)=Data
|
||
|
|
; ROOT("ID",File,Field,Seq)=Identifier
|
||
|
|
; If the segment is in display ready format
|
||
|
|
; ROOT("DISPLAY",LineNumber,0)=Line of display
|
||
|
|
;
|
||
|
|
;CHECK INPUT
|
||
|
|
S TRAN=+$G(TRAN)
|
||
|
|
S SEG=+$G(SEG)
|
||
|
|
Q:(('TRAN)!('SEG)) "-1^Did not pass pointer transaction or segment"
|
||
|
|
S OFFSET=+$G(OFFSET)
|
||
|
|
Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid transaction"
|
||
|
|
Q:('$D(^VAT(394.71,SEG))) "-1^Did not pass a valid segment"
|
||
|
|
Q:($G(ROOT)="") "-1^Did not pass reference to output array"
|
||
|
|
;DON'T EXTRACT IF PURGE FLAG IS SET
|
||
|
|
Q:($D(^VAT(394.61,"PURGE",1,TRAN))) "-1^Transaction has been flagged for purging"
|
||
|
|
;DECLARE VARIABLES
|
||
|
|
N LINE,IFN,TMP,SEQ,FILE,FIELD,VALUE,ID,DISPLAY
|
||
|
|
S LINE=OFFSET
|
||
|
|
;DETERMINE IF SEGMENT HAS DATA
|
||
|
|
Q:('$D(^VAT(394.62,"A-SEGMENT",TRAN,SEG))) "-1^Segment did not contain any data"
|
||
|
|
;DETERMINE IF SEGMENT IS DISPLAY READY
|
||
|
|
S DISPLAY=$D(^VAT(394.62,"A-DISPLAY",TRAN,SEG))
|
||
|
|
;DISPLAY READY
|
||
|
|
I (DISPLAY) D Q LINE-OFFSET
|
||
|
|
.;GET IFN (USED FOR DIPSLAY READY)
|
||
|
|
.S IFN=+$O(^VAT(394.62,"A-SEGMENT",TRAN,SEG,""))
|
||
|
|
.Q:('IFN)
|
||
|
|
.S SEQ=0
|
||
|
|
.F S SEQ=$O(^VAT(394.62,IFN,"DSP",SEQ)) Q:('SEQ) D
|
||
|
|
..S VALUE=$G(^VAT(394.62,IFN,"DSP",SEQ,0))
|
||
|
|
..S @ROOT@("DISPLAY",LINE,0)=VALUE
|
||
|
|
..S LINE=LINE+1
|
||
|
|
;EXTRACTION ARRAY
|
||
|
|
S IFN=""
|
||
|
|
F S IFN=$O(^VAT(394.62,"A-SEGMENT",TRAN,SEG,IFN)) Q:('IFN) D
|
||
|
|
.S TMP=$G(^VAT(394.62,IFN,0))
|
||
|
|
.S FILE=+$P(TMP,"^",3)
|
||
|
|
.Q:('FILE)
|
||
|
|
.S FIELD=+$P(TMP,"^",4)
|
||
|
|
.Q:('FIELD)
|
||
|
|
.S SEQ=+$G(^VAT(394.62,IFN,"SQNCE"))
|
||
|
|
.S VALUE=$G(^VAT(394.62,IFN,"VAL"))
|
||
|
|
.S ID=$G(^VAT(394.62,IFN,"IDNT1"))
|
||
|
|
.S @ROOT@("VALUE",FILE,FIELD,SEQ)=VALUE
|
||
|
|
.S @ROOT@("ID",FILE,FIELD,SEQ)=ID
|
||
|
|
Q 0
|