| 1 | XBFORM1 ; 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 | ;
|
|---|
| 7 | SUB(XBV1,XBLINX) ;EP extrensic to return new output transform
|
|---|
| 8 | D EN^XBNEW("XSUB^XBFORM1","XBV1;XBLINX")
|
|---|
| 9 | Q XBLINX
|
|---|
| 10 | ;
|
|---|
| 11 | XSUB ;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 | ;
|
|---|
| 22 | SCAN ;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)
|
|---|
| 33 | CHKMK ;
|
|---|
| 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
|
|---|
| 37 | SCANE ;
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | BLDLIN1 ;
|
|---|
| 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)
|
|---|
| 45 | BLDLIN1E ;
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
