ABMDF25X ; IHS/ASDST/DMJ - ADA-99 FORM ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;09/12/95 8:49 AM
;
; IHS/SD/SDR - v2.5 p10 - IM19963
; Changed all 1s to 2s in alignment lines
;
; IHS/SD/SDR v2.5 p10 - IM20078/IM20198
; Shorten dollar amounts to stop wrapping
;
; IHS/SD/SDR - v2.5 p10 - IM20337
; Add code to look at page 9F
;
MARG ;Set left and top margins
S U="^",(ABM("LM"),ABM("TM"),ABM("LN"))=0
I $D(^ABMDEXP(25,0)) S ABM("TM")=$P(^(0),U,3),ABM("LM")=$P(^(0),U,2)
W $$EN^ABMVDF("IOF")
I +ABM("TM") F ABM("I")=1:1:ABM("TM") W !
;
LOOP ;
;Loop thru line number array
S ABM("LN")=$O(ABMF(ABM("LN"))) I +ABM("LN")=0!(ABM("LN")>63) G XIT
;
;Set to correct format line
S ABM("FL")=ABM("LN")
I ABM("LN")>27,ABM("LN")<37 S ABM("FL")=27 ;Lines 27 thru 36 are same
I ABM("LN")>40,ABM("LN")<44 S ABM("FL")=41 ;Lines 41 thru 43 are same
;
;Set tab & format variables
S ABM("TABS")=$P($T(@ABM("FL")),";;",2)
S ABM("FMAT")=$P($T(@ABM("FL")),";;",3)
;
;Skip to req'd line
F Q:$Y-ABM("TM")>(ABM("LN")+0) W !
;
; Test Modes for setting Data Fields
G LOOP2:'$D(ABMF("TEST"))
F ABM("I")=1:1:$L(ABM("FMAT"),U) D
.I $P(ABM("TABS"),U,ABM("I"))]"" D
..S ABM("FLD")=""
..S $P(ABM("FLD"),"X",$P(ABM("FMAT"),U,ABM("I"))+1)=""
..I ABM("FLD")]"" D
...W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM"))
...D FRMT
G LOOP
;
LOOP2 ;
;Loop thru the pieces of the line array
F ABM("I")=1:1:$L(ABMF(ABM("LN")),U) D
.I $P(ABM("TABS"),U,ABM("I"))]"" D
..S ABM("FLD")=$P(ABMF(ABM("LN")),U,ABM("I"))
..I ABM("FLD")]"" D
...W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM"))
...D FRMT
G LOOP
;
FRMT ;
;Write the field in the designated format
S ABM("LTH")=$P(ABM("FMAT"),U,ABM("I"))
I +ABM("LTH")=0 S ABM("LTH")=99
;
I ABM("LTH")["$" D Q
.S ABM("LTH")=$P(ABM("LTH"),"$")
.W $J($FN(+ABM("FLD"),",",2),ABM("LTH"))
;
I ABM("LTH")["D" D Q
.S ABM("LTH")=$P(ABM("LTH"),"D")
.W $E(ABM("FLD"),4,5),"/",$E(ABM("FLD"),6,7),"/",($E(ABM("FLD"),1,3)+1700)
;
I ABM("LTH")["L" D
.S ABM("LTH")=$P(ABM("LTH"),"L")
.F Q:$L(ABM("FLD"))=ABM("LTH")!($L(ABM("FLD"))>ABM("LTH")) D
..S ABM("FLD")="0"_ABM("FLD")
;
I ABM("LTH")["C" D
.S ABM("LTH")=$P(ABM("LTH"),"C")
.S ABM("FLD")=$J("",ABM("LTH")-$L(ABM("FLD"))\2)_ABM("FLD")
;
I ABM("LTH")["R" D
.S ABM("LTH")=$P(ABM("LTH"),"R")
.S ABM("RT")=ABM("LTH")-$L(ABM("FLD"))+1
.I ABM("RT")>1 D
..S ABM("BLNK")=""
..S $P(ABM("BLNK")," ",ABM("RT"))=""
..S ABM("FLD")=ABM("BLNK")_ABM("FLD")
;
W $E(ABM("FLD"),1,ABM("LTH"))
Q
;
TEST ;
S ABMF("TEST")=1
F ABM=0:ABMF("TEST"):63 S ABMF(ABM)=""
G MARG
;
XIT ;
I '$D(ABM("MORE")) K ABMF,ABM
E K ABM("MORE")
Q
TEXT ;;TABS;;FIELD LENGTH
; FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)
2 ;;2;;1
3 ;;2;;1
5 ;;2;;30
6 ;;43;;30
7 ;;43;;30
8 ;;2^43;;30^30
9 ;;2;;30
10 ;;2;;30
11 ;;41^56^59^65;;10D^1^1^15
13 ;;16^26^41^57;;1^1^12^20
15 ;;2;;30
16 ;;42^47^53^62^70^75;;1^1^1^1^1^1
17 ;;2^15^18^23;;10D^1^1^10
18 ;;43;;30
19 ;;2^15^20^26^33^43;;10^1^1^1^1^30
20 ;;43;;30
21 ;;2;;30
22 ;;2;;30
23 ;;1^41^56^59^63;;30^10D^1^1^16
27 ;;2^10^14^18^30^36^43^71;;10D^2^2^8^6^5^29^8$
38 ;;71;;9$
39 ;;71;;9$
41 ;;2;;79
44 ;;42^50^55^58^68^73^78;;1^1^1^1^1^1^1
46 ;;2^28^42^51^67;;24^10D^1^1^10D
48 ;;43^51^54^69;;3^1^1^10D
50 ;;2^28^42^57^67;;27^10D^1^1^1
51 ;;56^77;;10D^2
55 ;;2^41^69;;30^27^10D
56 ;;2;;30
57 ;;2^47^68;;30^12^12
59 ;;43;;30
60 ;;2^13^26^43;;12^12^12^30
61 ;;9^46^68;;14^12^10
ABMDF25X ; IHS/ASDST/DMJ - ADA-99 FORM ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;09/12/95 8:49 AM
+3 ;
+4 ; IHS/SD/SDR - v2.5 p10 - IM19963
+5 ; Changed all 1s to 2s in alignment lines
+6 ;
+7 ; IHS/SD/SDR v2.5 p10 - IM20078/IM20198
+8 ; Shorten dollar amounts to stop wrapping
+9 ;
+10 ; IHS/SD/SDR - v2.5 p10 - IM20337
+11 ; Add code to look at page 9F
+12 ;
MARG ;Set left and top margins
+1 SET U="^"
SET (ABM("LM"),ABM("TM"),ABM("LN"))=0
+2 IF $DATA(^ABMDEXP(25,0))
SET ABM("TM")=$PIECE(^(0),U,3)
SET ABM("LM")=$PIECE(^(0),U,2)
+3 WRITE $$EN^ABMVDF("IOF")
+4 IF +ABM("TM")
FOR ABM("I")=1:1:ABM("TM")
WRITE !
+5 ;
LOOP ;
+1 ;Loop thru line number array
+2 SET ABM("LN")=$ORDER(ABMF(ABM("LN")))
IF +ABM("LN")=0!(ABM("LN")>63)
GOTO XIT
+3 ;
+4 ;Set to correct format line
+5 SET ABM("FL")=ABM("LN")
+6 ;Lines 27 thru 36 are same
IF ABM("LN")>27
IF ABM("LN")<37
SET ABM("FL")=27
+7 ;Lines 41 thru 43 are same
IF ABM("LN")>40
IF ABM("LN")<44
SET ABM("FL")=41
+8 ;
+9 ;Set tab & format variables
+10 SET ABM("TABS")=$PIECE($TEXT(@ABM("FL")),";;",2)
+11 SET ABM("FMAT")=$PIECE($TEXT(@ABM("FL")),";;",3)
+12 ;
+13 ;Skip to req'd line
+14 FOR
IF $Y-ABM("TM")>(ABM("LN")+0)
QUIT
WRITE !
+15 ;
+16 ; Test Modes for setting Data Fields
+17 IF '$DATA(ABMF("TEST"))
GOTO LOOP2
+18 FOR ABM("I")=1:1:$LENGTH(ABM("FMAT"),U)
Begin DoDot:1
+19 IF $PIECE(ABM("TABS"),U,ABM("I"))]""
Begin DoDot:2
+20 SET ABM("FLD")=""
+21 SET $PIECE(ABM("FLD"),"X",$PIECE(ABM("FMAT"),U,ABM("I"))+1)=""
+22 IF ABM("FLD")]""
Begin DoDot:3
+23 WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))
+24 DO FRMT
End DoDot:3
End DoDot:2
End DoDot:1
+25 GOTO LOOP
+26 ;
LOOP2 ;
+1 ;Loop thru the pieces of the line array
+2 FOR ABM("I")=1:1:$LENGTH(ABMF(ABM("LN")),U)
Begin DoDot:1
+3 IF $PIECE(ABM("TABS"),U,ABM("I"))]""
Begin DoDot:2
+4 SET ABM("FLD")=$PIECE(ABMF(ABM("LN")),U,ABM("I"))
+5 IF ABM("FLD")]""
Begin DoDot:3
+6 WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))
+7 DO FRMT
End DoDot:3
End DoDot:2
End DoDot:1
+8 GOTO LOOP
+9 ;
FRMT ;
+1 ;Write the field in the designated format
+2 SET ABM("LTH")=$PIECE(ABM("FMAT"),U,ABM("I"))
+3 IF +ABM("LTH")=0
SET ABM("LTH")=99
+4 ;
+5 IF ABM("LTH")["$"
Begin DoDot:1
+6 SET ABM("LTH")=$PIECE(ABM("LTH"),"$")
+7 WRITE $JUSTIFY($FNUMBER(+ABM("FLD"),",",2),ABM("LTH"))
End DoDot:1
QUIT
+8 ;
+9 IF ABM("LTH")["D"
Begin DoDot:1
+10 SET ABM("LTH")=$PIECE(ABM("LTH"),"D")
+11 WRITE $EXTRACT(ABM("FLD"),4,5),"/",$EXTRACT(ABM("FLD"),6,7),"/",($EXTRACT(ABM("FLD"),1,3)+1700)
End DoDot:1
QUIT
+12 ;
+13 IF ABM("LTH")["L"
Begin DoDot:1
+14 SET ABM("LTH")=$PIECE(ABM("LTH"),"L")
+15 FOR
IF $LENGTH(ABM("FLD"))=ABM("LTH")!($LENGTH(ABM("FLD"))>ABM("LTH"))
QUIT
Begin DoDot:2
+16 SET ABM("FLD")="0"_ABM("FLD")
End DoDot:2
End DoDot:1
+17 ;
+18 IF ABM("LTH")["C"
Begin DoDot:1
+19 SET ABM("LTH")=$PIECE(ABM("LTH"),"C")
+20 SET ABM("FLD")=$JUSTIFY("",ABM("LTH")-$LENGTH(ABM("FLD"))\2)_ABM("FLD")
End DoDot:1
+21 ;
+22 IF ABM("LTH")["R"
Begin DoDot:1
+23 SET ABM("LTH")=$PIECE(ABM("LTH"),"R")
+24 SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))+1
+25 IF ABM("RT")>1
Begin DoDot:2
+26 SET ABM("BLNK")=""
+27 SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""
+28 SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
End DoDot:2
End DoDot:1
+29 ;
+30 WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))
+31 QUIT
+32 ;
TEST ;
+1 SET ABMF("TEST")=1
+2 FOR ABM=0:ABMF("TEST"):63
SET ABMF(ABM)=""
+3 GOTO MARG
+4 ;
XIT ;
+1 IF '$DATA(ABM("MORE"))
KILL ABMF,ABM
+2 IF '$TEST
KILL ABM("MORE")
+3 QUIT
TEXT ;;TABS;;FIELD LENGTH
+1 ; FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)
2 ;;2;;1
3 ;;2;;1
5 ;;2;;30
6 ;;43;;30
7 ;;43;;30
8 ;;2^43;;30^30
9 ;;2;;30
10 ;;2;;30
11 ;;41^56^59^65;;10D^1^1^15
13 ;;16^26^41^57;;1^1^12^20
15 ;;2;;30
16 ;;42^47^53^62^70^75;;1^1^1^1^1^1
17 ;;2^15^18^23;;10D^1^1^10
18 ;;43;;30
19 ;;2^15^20^26^33^43;;10^1^1^1^1^30
20 ;;43;;30
21 ;;2;;30
22 ;;2;;30
23 ;;1^41^56^59^63;;30^10D^1^1^16
27 ;;2^10^14^18^30^36^43^71;;10D^2^2^8^6^5^29^8$
38 ;;71;;9$
39 ;;71;;9$
41 ;;2;;79
44 ;;42^50^55^58^68^73^78;;1^1^1^1^1^1^1
46 ;;2^28^42^51^67;;24^10D^1^1^10D
48 ;;43^51^54^69;;3^1^1^10D
50 ;;2^28^42^57^67;;27^10D^1^1^1
51 ;;56^77;;10D^2
55 ;;2^41^69;;30^27^10D
56 ;;2;;30
57 ;;2^47^68;;30^12^12
59 ;;43;;30
60 ;;2^13^26^43;;12^12^12^30
61 ;;9^46^68;;14^12^10
