source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF2A2.m@ 1093

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

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1IBDF2A2 ;ALB/CJM - ENCOUNTER FORM (IBDF2A continued);NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
3 ;
4WCMP ;write the compiled version
5 N SUB,ND,WIDTH,STRING,LINES,ROW,FNAME,TYPE,UNIT,TYPENODE,ND2,SLCTN
6 S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"S",SUB)) Q:'SUB S ND=$G(^IBE(357.1,IBBLK,"S",SUB,0)) D DRWSTR^IBDFU(+$P(ND,"^"),+$P(ND,"^",2),$P(ND,"^",5,200),$P(ND,"^",3),$P(ND,"^",4))
7 S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"V",SUB)) Q:'SUB S ND=$G(^IBE(357.1,IBBLK,"V",SUB,0)) D DRWVLINE^IBDFU(+$P(ND,"^"),+$P(ND,"^",2),+$P(ND,"^",3),$P(ND,"^",4))
8 ;
9 ;bubbles
10 S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"B",SUB)) Q:'SUB D
11 .S ND=$G(^IBE(357.1,IBBLK,"B",SUB,0))
12 .S ND2=$G(^IBE(357.1,IBBLK,"B",SUB,2))
13 .S SLCTN=$P($G(ND),"^",14)
14 .S SUBHDR=$P($G(^IBE(357.1,IBBLK,"B",SUB,1)),"^") D
15 ..D DRWBBL^IBDFM1(+$P(ND,"^"),+$P(ND,"^",2),+$P(ND,"^",3),$P(ND,"^",4),$P(ND,"^",5),$P(ND,"^",6),$P(ND,"^",7),$P(ND,"^",8),$P(ND,"^",9),$P(ND,"^",10),$P(ND,"^",11),$P(ND,"^",12),SUBHDR,$P(ND,"^",13),$G(ND2),$G(SLCTN))
16 ;
17 ;handprint
18 S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"H",SUB)) Q:'SUB S ND=$G(^IBE(357.1,IBBLK,"H",SUB,0)) D
19 .D DRWHAND^IBDFM1(+ND,+$P(ND,"^",2),+$P(ND,"^",3),$P(ND,"^",4),$P(ND,"^",6),$P(ND,"^",7),$P(ND,"^",8),$P(ND,"^",9),$P(ND,"^",10),$P(ND,"^",12),$P(ND,"^",14),$P(ND,"^",15),$P(ND,"^",17))
20 Q
21 ;
22SAVE(ARRAY,VAR) ;saves one array to the string=VAR, pass by reference
23 N SUB,I
24 S I=1,SUB="" F S SUB=$O(ARRAY(SUB)) Q:SUB="" S $P(VAR,"^",I)=ARRAY(SUB),I=I+1
25 Q
26RESTORE(ARRAY,VAR) ;restores the array from the string=VAR, pass by reference
27 N SUB,I
28 S I=1,SUB="" F S SUB=$O(ARRAY(SUB)) Q:SUB="" S ARRAY(SUB)=$P(VAR,"^",I),I=I+1
29 Q
Note: See TracBrowser for help on using the repository browser.