source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUPD25.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1VAQUPD25 ;ALB/JRP - EXTRACT SEGMENT FROM DATA FILE;08-APR-93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EXTARR(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
Note: See TracBrowser for help on using the repository browser.