source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFU1A.m@ 1150

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1IBDFU1A ;ALB/CJM - ENCOUNTER FORM (read data field description);NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;utilities
4FLDDESCR(IBFLD) ;IBFLD should be a pointer to the IB DATA FIELD file
5 ;parses the 0 NODE and returns the fields
6 ;returns 1 if the field description is not found
7 N NODE
8 Q:'$G(IBFLD) 0
9 S:$G(IBFLD) NODE=$G(^IBE(357.5,IBFLD,0))
10 Q:NODE="" 0
11 S FLDNAME=$P(NODE,"^",1)
12 S BLK=$P(NODE,"^",2)
13 S RTN=$P(NODE,"^",3)
14 S LASTITEM=$P(NODE,"^",4)
15 S ITEM=+$P(NODE,"^",5)
16 S LABEL=$P(NODE,"^",6)
17 S DISPLAY=$P(NODE,"^",7)
18 S XIO=+$P(NODE,"^",10)
19 S YIO=+$P(NODE,"^",11)
20 S HIO=+$P(NODE,"^",12)
21 S SPACING=$P(NODE,"^",13)
22 S WIO=+$P(NODE,"^",14)
23 Q 1
24SFLDDSCR(IBFLD,LAST) ;gets the next subfield - LAST is the last subfield processed, IBFLD is the field
25 ;outputs - LABEL,XIO,YIO,WIO,XLAB,YLAB,PIECE,LENGTH,LAST
26 ;returns 0 if no more subfields, LAST otherwise
27 ;
28 N NODE
29 F S LAST=$O(^IBE(357.5,IBFLD,2,LAST)) Q:'LAST S NODE=$G(^IBE(357.5,IBFLD,2,LAST,0)) I NODE'="" D Q
30 .S LABEL=$P(NODE,"^",1),DISPLAY=$P(NODE,"^",3),XLAB=$P(NODE,"^",4),YLAB=$P(NODE,"^",5),YIO=$P(NODE,"^",6),XIO=$P(NODE,"^",7),WIO=$P(NODE,"^",8),PIECE=$P(NODE,"^",9)
31 Q LAST
Note: See TracBrowser for help on using the repository browser.