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