Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDF2A2

IBDF2A2.m

Go to the documentation of this file.
  1. IBDF2A2 ;ALB/CJM - ENCOUNTER FORM (IBDF2A continued);NOV 16,1992
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
  1. ;
  1. WCMP ;write the compiled version
  1. N SUB,ND,WIDTH,STRING,LINES,ROW,FNAME,TYPE,UNIT,TYPENODE,ND2,SLCTN
  1. 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))
  1. 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))
  1. ;
  1. ;bubbles
  1. S SUB=0 F S SUB=$O(^IBE(357.1,IBBLK,"B",SUB)) Q:'SUB D
  1. .S ND=$G(^IBE(357.1,IBBLK,"B",SUB,0))
  1. .S ND2=$G(^IBE(357.1,IBBLK,"B",SUB,2))
  1. .S SLCTN=$P($G(ND),"^",14)
  1. .S SUBHDR=$P($G(^IBE(357.1,IBBLK,"B",SUB,1)),"^") D
  1. ..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))
  1. ;
  1. ;handprint
  1. 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
  1. .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))
  1. Q
  1. ;
  1. SAVE(ARRAY,VAR) ;saves one array to the string=VAR, pass by reference
  1. N SUB,I
  1. S I=1,SUB="" F S SUB=$O(ARRAY(SUB)) Q:SUB="" S $P(VAR,"^",I)=ARRAY(SUB),I=I+1
  1. Q
  1. RESTORE(ARRAY,VAR) ;restores the array from the string=VAR, pass by reference
  1. N SUB,I
  1. S I=1,SUB="" F S SUB=$O(ARRAY(SUB)) Q:SUB="" S ARRAY(SUB)=$P(VAR,"^",I),I=I+1
  1. Q