- ABMDF18X ; IHS/ASDST/DMJ - ADA-99 FORM ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;09/12/95 8:49 AM
- ;
- ; IHS/ASDS/LSL - 06/24/00 - Patch 3 - NOIS DXX-0600-140080
- ; Routine created (required by Wisconsin medicaid)
- ;
- MARG ;Set left and top margins
- S U="^",(ABM("LM"),ABM("TM"),ABM("LN"))=0
- I $D(^ABMDEXP(18,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")>62) G XIT
- ;
- ;Set to correct format line
- S ABM("FL")=ABM("LN")
- I ABM("LN")>40,ABM("LN")<49 S ABM("FL")=41 ;Lines 41 thru 48 are same
- I ABM("LN")>53,ABM("LN")<57 S ABM("FL")=54 ;Lines 54 thru 56 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"):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;;1
- 2 ;;1^38;;1^42
- 4 ;;1^29;;1^42
- 5 ;;1^14^29^65^68;;1^12^34^2^10
- 7 ;;2^31^53^75;;27^19^19^2
- 9 ;;4^8^12^17^37^40^44^66;;2^2^4^17C^1^1^12^10
- 11 ;;3^5^10^13^16^46^63;;1^1^1^1^23^12^15
- 13 ;;2^15^33^40^53^56^61^70;;12^17^7^1^1^1^1^10
- 15 ;;2^43;;37^37
- 17 ;;2^30^44^48^52^61^63^67;;26^12^2^2^4^1^1^12
- 19 ;;2^25^29^46^64;;21^2^10^14^15
- 21 ;;3^7^11^21^25^29^35^37^43^49^56^64;;2^2^4^1^1^1^1^1^1^1^1^1
- 22 ;;46^64;;14^15
- 25 ;;4^28^44^64;;23^10D^21^10D
- 28 ;;2^36^52^64;;29^12^10^15
- 30 ;;2^36^52^61^68^71^74;;33^12^10D^1^1^1^1
- 31 ;;35^43^46^70^73;;1^2^1^1^1
- 32 ;;2^23^27;;19^2^6
- 33 ;;9^12^23^41^59^75;;1^1^14^15^10D^4
- 34 ;;23^25^44^53^60;;1^1^1^1^1
- 36 ;;13^47;;22^32
- 41 ;;0^2^4^9^14^20^30^38^41^61^71;;2^2^4^4^5^8^6^2^19^6$^9
- 50 ;;62;;6$
- 51 ;;62;;6$
- 52 ;;62;;6$
- 53 ;;13^62;;37^6$
- 54 ;;1^62;;45^6$
- 58 ;;48;;30
- 59 ;;1^19^34;;16^12^10D
- 60 ;;48^68^73;;17^2^7
- ABMDF18X ; 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/ASDS/LSL - 06/24/00 - Patch 3 - NOIS DXX-0600-140080
- +5 ; Routine created (required by Wisconsin medicaid)
- +6 ;
- MARG ;Set left and top margins
- +1 SET U="^"
- SET (ABM("LM"),ABM("TM"),ABM("LN"))=0
- +2 IF $DATA(^ABMDEXP(18,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")>62)
- GOTO XIT
- +3 ;
- +4 ;Set to correct format line
- +5 SET ABM("FL")=ABM("LN")
- +6 ;Lines 41 thru 48 are same
- IF ABM("LN")>40
- IF ABM("LN")<49
- SET ABM("FL")=41
- +7 ;Lines 54 thru 56 are same
- IF ABM("LN")>53
- IF ABM("LN")<57
- SET ABM("FL")=54
- +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 IF ABM("LTH")["$"
- Begin DoDot:1
- +5 SET ABM("LTH")=$PIECE(ABM("LTH"),"$")
- +6 WRITE $JUSTIFY($FNUMBER(+ABM("FLD"),",",2),ABM("LTH"))
- End DoDot:1
- QUIT
- +7 IF ABM("LTH")["D"
- Begin DoDot:1
- +8 SET ABM("LTH")=$PIECE(ABM("LTH"),"D")
- +9 WRITE $EXTRACT(ABM("FLD"),4,5),"/",$EXTRACT(ABM("FLD"),6,7),"/",($EXTRACT(ABM("FLD"),1,3)+1700)
- End DoDot:1
- QUIT
- +10 IF ABM("LTH")["L"
- Begin DoDot:1
- +11 SET ABM("LTH")=$PIECE(ABM("LTH"),"L")
- +12 FOR
- IF $LENGTH(ABM("FLD"))=ABM("LTH")!($LENGTH(ABM("FLD"))>ABM("LTH"))
- QUIT
- Begin DoDot:2
- +13 SET ABM("FLD")="0"_ABM("FLD")
- End DoDot:2
- End DoDot:1
- +14 IF ABM("LTH")["C"
- Begin DoDot:1
- +15 SET ABM("LTH")=$PIECE(ABM("LTH"),"C")
- +16 SET ABM("FLD")=$JUSTIFY("",ABM("LTH")-$LENGTH(ABM("FLD"))\2)_ABM("FLD")
- End DoDot:1
- +17 IF ABM("LTH")["R"
- Begin DoDot:1
- +18 SET ABM("LTH")=$PIECE(ABM("LTH"),"R")
- +19 SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))+1
- +20 IF ABM("RT")>1
- Begin DoDot:2
- +21 SET ABM("BLNK")=""
- +22 SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""
- +23 SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
- End DoDot:2
- End DoDot:1
- +24 WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))
- +25 QUIT
- +26 ;
- TEST ;
- +1 SET ABMF("TEST")=1
- +2 FOR ABM=0:ABMF("TEST"):62
- 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)
- 1 ;;1;;1
- 2 ;;1^38;;1^42
- 4 ;;1^29;;1^42
- 5 ;;1^14^29^65^68;;1^12^34^2^10
- 7 ;;2^31^53^75;;27^19^19^2
- 9 ;;4^8^12^17^37^40^44^66;;2^2^4^17C^1^1^12^10
- 11 ;;3^5^10^13^16^46^63;;1^1^1^1^23^12^15
- 13 ;;2^15^33^40^53^56^61^70;;12^17^7^1^1^1^1^10
- 15 ;;2^43;;37^37
- 17 ;;2^30^44^48^52^61^63^67;;26^12^2^2^4^1^1^12
- 19 ;;2^25^29^46^64;;21^2^10^14^15
- 21 ;;3^7^11^21^25^29^35^37^43^49^56^64;;2^2^4^1^1^1^1^1^1^1^1^1
- 22 ;;46^64;;14^15
- 25 ;;4^28^44^64;;23^10D^21^10D
- 28 ;;2^36^52^64;;29^12^10^15
- 30 ;;2^36^52^61^68^71^74;;33^12^10D^1^1^1^1
- 31 ;;35^43^46^70^73;;1^2^1^1^1
- 32 ;;2^23^27;;19^2^6
- 33 ;;9^12^23^41^59^75;;1^1^14^15^10D^4
- 34 ;;23^25^44^53^60;;1^1^1^1^1
- 36 ;;13^47;;22^32
- 41 ;;0^2^4^9^14^20^30^38^41^61^71;;2^2^4^4^5^8^6^2^19^6$^9
- 50 ;;62;;6$
- 51 ;;62;;6$
- 52 ;;62;;6$
- 53 ;;13^62;;37^6$
- 54 ;;1^62;;45^6$
- 58 ;;48;;30
- 59 ;;1^19^34;;16^12^10D
- 60 ;;48^68^73;;17^2^7
