ABMDF12X ; IHS/ASDST/DMJ - ADA-94 FORM ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;09/12/95 8:49 AM
; IHS/SD/SDR - V2.5 P2 - 4/17/02 - NOIS PJB-0302-90027
; Modified to fix problem with format for ADA-94 17b print
; format
;
; IHS/SD/EFG - V2.5 P8 - IM16385
; Fix year displaying in wrong position
;
; IHS/SD/SDR - v2.5 p9 - IM14774
; Changed line1 piece3 to 1 from 32
; Changed line6 piece2 to 32 from 33
; Changed line7 piece2 to 32 from 33
;
; IHS/SD/SDR - v2.5 p9 - IM17574
; Changed line13 from 6^10 to 4^8
; Changed line 15 from 10^13 to 6^11
;
; IHS/SD/SDR - v2.5 p9 - IM18707
; Changed line30 ;;13^10 to ;;13^12
;
MARG ;Set left and top margins
S U="^",(ABM("LM"),ABM("TM"),ABM("LN"))=0
I $D(^ABMDEXP(4,0)) S ABM("TM")=$P(^(0),U,2),ABM("LM")=$P(^(0),U,3)
W $$EN^ABMVDF("IOF")
I +ABM("TM") F ABM("I")=1:1:ABM("TM") W !
;
;Loop thru line number array
LOOP S ABM("LN")=$O(ABMF(ABM("LN"))) I +ABM("LN")=0!(ABM("LN")>62) G XIT
;
;Set to correct format line
S ABM("FL")=ABM("LN")
I ABM("LN")>35,ABM("LN")<50 S ABM("FL")=36 ;Lines 36 thru 49 are same
I ABM("LN")>50,ABM("LN")<56 S ABM("FL")=51 ;Lines 51 thru 55 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) I $P(ABM("TABS"),U,ABM("I"))]"" S ABM("FLD")="",$P(ABM("FLD"),"X",$P(ABM("FMAT"),U,ABM("I"))+1)="" I ABM("FLD")]"" W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM")) D FRMT
G LOOP
;
;Loop thru the pieces of the line array
LOOP2 F ABM("I")=1:1:$L(ABMF(ABM("LN")),U) I $P(ABM("TABS"),U,ABM("I"))]"" S ABM("FLD")=$P(ABMF(ABM("LN")),U,ABM("I")) I ABM("FLD")]"" W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM")) D FRMT
G LOOP
;
;Write the field in the designated format
FRMT S ABM("LTH")=$P(ABM("FMAT"),U,ABM("I")) I +ABM("LTH")=0 S ABM("LTH")=99
I ABM("LTH")["$" S ABM("LTH")=$P(ABM("LTH"),"$") W $J($FN(+ABM("FLD"),",",2),ABM("LTH")) Q
I ABM("LTH")["D" S ABM("LTH")=$P(ABM("LTH"),"D") W $E(ABM("FLD"),4,5),"-",$E(ABM("FLD"),6,7),"-",$E(ABM("FLD"),2,3) Q
I ABM("LTH")["L" S ABM("LTH")=$P(ABM("LTH"),"L") F Q:$L(ABM("FLD"))=ABM("LTH")!($L(ABM("FLD"))>ABM("LTH")) S ABM("FLD")="0"_ABM("FLD")
I ABM("LTH")["C" S ABM("LTH")=$P(ABM("LTH"),"C") S ABM("FLD")=$J("",ABM("LTH")-$L(ABM("FLD"))\2)_ABM("FLD")
I ABM("LTH")["R" S ABM("LTH")=$P(ABM("LTH"),"R") S ABM("RT")=ABM("LTH")-$L(ABM("FLD"))+1 I ABM("RT")>1 S ABM("BLNK")="",$P(ABM("BLNK")," ",ABM("RT"))="",ABM("FLD")=ABM("BLNK")_ABM("FLD")
W $E(ABM("FLD"),1,ABM("LTH"))
Q
;
TEST S ABMF("TEST")=1
F ABM=0:ABMF("TEST"):62 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)
1 ;;1^22^46;;1^1^32
2 ;;1^22^46;;1^1^32
3 ;;1^46;;12^32
4 ;;7^27^46;;11^17^32
6 ;;28^32^58;;1^1^20R
7 ;;2^28^32^37^43^45^47^50^53^58;;24^1^1^5^1^1^2^2^4^20R
9 ;;2^50^68;;24^17^11C
10 ;;2^27^50^68;;24^11^17^12C
11 ;;2^26^41^42^45^50^68;;24^14^2^2^4^17^11C
13 ;;4^8^16^41^57;;1^1^23^15^22
14 ;;16^41^57;;23^15C^22
15 ;;6^11^16^41^57;;1^1^23^15C^22
17 ;;2^58^63;;25^1^1
18 ;;2^28^42^47^51^58^63^68;;25^11^2^2^4^1^1^6
21 ;;2^30^42^70;;25^8D^25^8D
24 ;;2^52^54^56;;37^1^1^22
26 ;;2^52^54^56;;37^1^1^22
28 ;;2^52^54^56;;37^1^1^22
30 ;;2^17^30^52^54^56^71;;13^12^12^1^1^13^8D
32 ;;2^12^16^19^22^34^36^38^52^54^64^76;;8D^1^1^1^1^1^1^2^1^1^8D^2
36 ;;13^17^23^49^51^53^56^64;;3R^5^25^2^2^2^7R^6$
51 ;;1^64;;62^6$
56 ;;61;;9$
58 ;;2^27^42^61;;23^11R^8D^9$
60 ;;69;;12
61 ;;1^33^45^50^69;;30^9^2^5^12
62 ;;69;;12
63 ;;69;;12
ABMDF12X ; IHS/ASDST/DMJ - ADA-94 FORM ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;09/12/95 8:49 AM
+3 ; IHS/SD/SDR - V2.5 P2 - 4/17/02 - NOIS PJB-0302-90027
+4 ; Modified to fix problem with format for ADA-94 17b print
+5 ; format
+6 ;
+7 ; IHS/SD/EFG - V2.5 P8 - IM16385
+8 ; Fix year displaying in wrong position
+9 ;
+10 ; IHS/SD/SDR - v2.5 p9 - IM14774
+11 ; Changed line1 piece3 to 1 from 32
+12 ; Changed line6 piece2 to 32 from 33
+13 ; Changed line7 piece2 to 32 from 33
+14 ;
+15 ; IHS/SD/SDR - v2.5 p9 - IM17574
+16 ; Changed line13 from 6^10 to 4^8
+17 ; Changed line 15 from 10^13 to 6^11
+18 ;
+19 ; IHS/SD/SDR - v2.5 p9 - IM18707
+20 ; Changed line30 ;;13^10 to ;;13^12
+21 ;
MARG ;Set left and top margins
+1 SET U="^"
SET (ABM("LM"),ABM("TM"),ABM("LN"))=0
+2 IF $DATA(^ABMDEXP(4,0))
SET ABM("TM")=$PIECE(^(0),U,2)
SET ABM("LM")=$PIECE(^(0),U,3)
+3 WRITE $$EN^ABMVDF("IOF")
+4 IF +ABM("TM")
FOR ABM("I")=1:1:ABM("TM")
WRITE !
+5 ;
+6 ;Loop thru line number array
LOOP SET ABM("LN")=$ORDER(ABMF(ABM("LN")))
IF +ABM("LN")=0!(ABM("LN")>62)
GOTO XIT
+1 ;
+2 ;Set to correct format line
+3 SET ABM("FL")=ABM("LN")
+4 ;Lines 36 thru 49 are same
IF ABM("LN")>35
IF ABM("LN")<50
SET ABM("FL")=36
+5 ;Lines 51 thru 55 are same
IF ABM("LN")>50
IF ABM("LN")<56
SET ABM("FL")=51
+6 ;
+7 ;Set tab & format variables
+8 SET ABM("TABS")=$PIECE($TEXT(@ABM("FL")),";;",2)
+9 SET ABM("FMAT")=$PIECE($TEXT(@ABM("FL")),";;",3)
+10 ;
+11 ;Skip to req'd line
+12 FOR
IF $Y-ABM("TM")>(ABM("LN")+0)
QUIT
WRITE !
+13 ;
+14 ; Test Modes for setting Data Fields
+15 IF '$DATA(ABMF("TEST"))
GOTO LOOP2
+16 FOR ABM("I")=1:1:$LENGTH(ABM("FMAT"),U)
IF $PIECE(ABM("TABS"),U,ABM("I"))]""
SET ABM("FLD")=""
SET $PIECE(ABM("FLD"),"X",$PIECE(ABM("FMAT"),U,ABM("I"))+1)=""
IF ABM("FLD")]""
WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))
DO FRMT
+17 GOTO LOOP
+18 ;
+19 ;Loop thru the pieces of the line array
LOOP2 FOR ABM("I")=1:1:$LENGTH(ABMF(ABM("LN")),U)
IF $PIECE(ABM("TABS"),U,ABM("I"))]""
SET ABM("FLD")=$PIECE(ABMF(ABM("LN")),U,ABM("I"))
IF ABM("FLD")]""
WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))
DO FRMT
+1 GOTO LOOP
+2 ;
+3 ;Write the field in the designated format
FRMT SET ABM("LTH")=$PIECE(ABM("FMAT"),U,ABM("I"))
IF +ABM("LTH")=0
SET ABM("LTH")=99
+1 IF ABM("LTH")["$"
SET ABM("LTH")=$PIECE(ABM("LTH"),"$")
WRITE $JUSTIFY($FNUMBER(+ABM("FLD"),",",2),ABM("LTH"))
QUIT
+2 IF ABM("LTH")["D"
SET ABM("LTH")=$PIECE(ABM("LTH"),"D")
WRITE $EXTRACT(ABM("FLD"),4,5),"-",$EXTRACT(ABM("FLD"),6,7),"-",$EXTRACT(ABM("FLD"),2,3)
QUIT
+3 IF ABM("LTH")["L"
SET ABM("LTH")=$PIECE(ABM("LTH"),"L")
FOR
IF $LENGTH(ABM("FLD"))=ABM("LTH")!($LENGTH(ABM("FLD"))>ABM("LTH"))
QUIT
SET ABM("FLD")="0"_ABM("FLD")
+4 IF ABM("LTH")["C"
SET ABM("LTH")=$PIECE(ABM("LTH"),"C")
SET ABM("FLD")=$JUSTIFY("",ABM("LTH")-$LENGTH(ABM("FLD"))\2)_ABM("FLD")
+5 IF ABM("LTH")["R"
SET ABM("LTH")=$PIECE(ABM("LTH"),"R")
SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))+1
IF ABM("RT")>1
SET ABM("BLNK")=""
SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""
SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
+6 WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))
+7 QUIT
+8 ;
TEST SET ABMF("TEST")=1
+1 FOR ABM=0:ABMF("TEST"):62
SET ABMF(ABM)=""
+2 GOTO MARG
+3 ;
XIT IF '$DATA(ABM("MORE"))
KILL ABMF,ABM
+1 IF '$TEST
KILL ABM("MORE")
+2 QUIT
TEXT ;;TABS;;FIELD LENGTH
+1 ; FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)
1 ;;1^22^46;;1^1^32
2 ;;1^22^46;;1^1^32
3 ;;1^46;;12^32
4 ;;7^27^46;;11^17^32
6 ;;28^32^58;;1^1^20R
7 ;;2^28^32^37^43^45^47^50^53^58;;24^1^1^5^1^1^2^2^4^20R
9 ;;2^50^68;;24^17^11C
10 ;;2^27^50^68;;24^11^17^12C
11 ;;2^26^41^42^45^50^68;;24^14^2^2^4^17^11C
13 ;;4^8^16^41^57;;1^1^23^15^22
14 ;;16^41^57;;23^15C^22
15 ;;6^11^16^41^57;;1^1^23^15C^22
17 ;;2^58^63;;25^1^1
18 ;;2^28^42^47^51^58^63^68;;25^11^2^2^4^1^1^6
21 ;;2^30^42^70;;25^8D^25^8D
24 ;;2^52^54^56;;37^1^1^22
26 ;;2^52^54^56;;37^1^1^22
28 ;;2^52^54^56;;37^1^1^22
30 ;;2^17^30^52^54^56^71;;13^12^12^1^1^13^8D
32 ;;2^12^16^19^22^34^36^38^52^54^64^76;;8D^1^1^1^1^1^1^2^1^1^8D^2
36 ;;13^17^23^49^51^53^56^64;;3R^5^25^2^2^2^7R^6$
51 ;;1^64;;62^6$
56 ;;61;;9$
58 ;;2^27^42^61;;23^11R^8D^9$
60 ;;69;;12
61 ;;1^33^45^50^69;;30^9^2^5^12
62 ;;69;;12
63 ;;69;;12
