source: IHS-VA_UTILITIES-XB/trunk/XBFORM1.m@ 1736

Last change on this file since 1736 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.2 KB
Line 
1XBFORM1 ; IHS/ADC/GTH - sub x in output transforms [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ;XBV1=NEW CODE,XBLINX=original out transform
5 Q
6 ;
7SUB(XBV1,XBLINX) ;EP extrensic to return new output transform
8 D EN^XBNEW("XSUB^XBFORM1","XBV1;XBLINX")
9 Q XBLINX
10 ;
11XSUB ;EP - do it
12 NEW XB,XBT
13 D SCAN
14 I 'XBMK Q
15 S XBLIN=XBLINX
16 D BLDLIN1
17 S XBLINX=XBLIN1
18 Q
19 ;
20 ;----------------- SUB ROUTINES ---------------
21 ;
22SCAN ;EP - scan for X
23 S XBVX="X"
24 S XBP=" #&'()*+,'-/<=>@\_?;:[]!""",XBS=XBP
25 S XBL=$L(XBVX)
26 F XBI=1:1 S XB(XBI)=$F(XBLINX,XBVX,$G(XB(XBI-1))+1)-XBL Q:XB(XBI)'>0 D
27 .S XB(XBI,"M")=0,XB(XBI,0)=XB(XBI)
28 .I XBP[$E(XBLINX,XB(XBI)-1),XBS[$E(XBLINX,XB(XBI)+XBL) S XB(XBI,"M")=1
29 .S XB("B",XB(XBI))=XBI,XB("E",XB(XBI)+XBL-1)=XBI
30 .S XB(XBI,"E")=XB(XBI)+XBL-1
31 .Q
32 KILL XB(XBI)
33CHKMK ;
34 S XBMK="",XBJM=""
35 F S XBJM=$O(XB(XBJM)) Q:XBJM="" I $G(XB(XBJM,"M")) S XBMK=1 Q
36 KILL XBJM
37SCANE ;
38 Q
39 ;
40BLDLIN1 ;
41 S XBLIN=XBLINX,XBV0="X"
42 S XBLIN0=XBLIN,XBSUB=XBV0_":"_XBV1,XBLIN1=""
43 F XBI=1:1 Q:'$D(XB(XBI)) S XBLIN1=XBLIN1_$E(XBLIN,$G(XB(XBI-1,"E"))+1,XB(XBI,0)-1)_$S(XB(XBI,"M"):XBV1,1:XBV0)
44 S XBI=XBI-1 S XBLIN1=XBLIN1_$E(XBLIN,XB(XBI,"E")+1,999)
45BLDLIN1E ;
46 Q
47 ;
Note: See TracBrowser for help on using the repository browser.