- ABMDF1X ; IHS/ASDST/DMJ - PRINT UB82 ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;
- ;
- K ABM
- U IO
- ;
- MARG ;Set left and top margins
- W $$EN^ABMVDF("IOF")
- S U="^",(ABM("LM"),ABM("TM"),ABM("LN"))=0
- I $D(^ABMDEXP(1,0)) S ABM("LM")=$P(^(0),U,2),ABM("TM")=$P(^(0),U,3)
- 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")>63) G XIT
- ;
- ;Check for invalid line numbers
- F ABM("I")=7,9,40,45 I ABM("I")=ABM("LN") Q
- I G LOOP
- ;
- ;Set to correct format line
- S ABM("FL")=$S(ABM("LN")=1:2,ABM("LN")=3:4,ABM("LN")=5:6,ABM("LN")=11:12,ABM("LN")=13:14,ABM("LN")=15:14,ABM("LN")>17&(ABM("LN")<40):17,ABM("LN")=42:41,ABM("LN")=43:41,ABM("LN")=47:46,1:99)
- I ABM("FL")=99 S ABM("FL")=$S(ABM("LN")=48:46,ABM("LN")=49:50,ABM("LN")=51:50,ABM("LN")=58:59,ABM("LN")=60:61,ABM("LN")=62:63,1:ABM("LN"))
- ;
- ;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")-2) 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")["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("CTR")=(ABM("LTH")-$L(ABM("FLD")))\2 I ABM("CTR")>1 S ABM("BLNK")="",$P(ABM("BLNK")," ",ABM("CTR"))="",ABM("FLD")=ABM("BLNK")_ABM("FLD")
- I ABM("LTH")["R" S ABM("LTH")=$P(ABM("LTH"),"R") S ABM("RT")=ABM("LTH")-$L(ABM("FLD")) 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"):60 S ABMF(ABM)=""
- G MARG
- ;
- XIT K ABMF,ABM
- Q
- ;
- TEXT ;;TABS;;FIELD LENGTH/FORMAT ($-$ FORMAT,L-LNTH REQ'D,C-CENTER,R-RIGHT)
- 2 ;;0^26^58^77;;25^31C^17C^3
- 4 ;;0^26^40^51^60^73;;25^13C^10C^8C^12C^6C
- 6 ;;0^32;;30^47C
- 8 ;;0^9^12^14^23^26^29^31^34^37^40^49^58^62^66^69^72;;8^1^1^8^2L^1^1^2L^2L^2L^8^8^3C^3C^2^2^8C
- 10 ;;0^3^12^15^24^27^36^39^48^51^60^63^72;;2L^8^2L^8^2L^8^2L^8^2L^8^2L^8^8
- 12 ;;0^32^35^38^41^44^47^50^53^57^60^63;;31^2L^2L^2L^2L^2L^2^2^2^1^2L^17C
- 14 ;;0^32^35^44^47^56^59^68^71;;31^2L^8$^2L^8$^2L^8$
- 16 ;;51^61^71;;9C^9C^9C
- 17 ;;0^25^33^37^41^51^61^71;;24^7^3^3C^9$^9$^9$^9$
- 41 ;;0^26^29^31^41^51^61^71;;25^1^1^9$^9$^9$^9$^9$
- 44 ;;51^61^71;;9$^9$^9$
- 46 ;;0^25^28^31^48^63;;24^1^2L^16C^14^17C
- 50 ;;0^3^6^31^43;;2^1^24^11^37
- 52 ;;19;;26
- 53 ;;0^46^53^60^67^74;;45^6^6^6^6
- 54 ;;22;;22
- 55 ;;1^3^45^51^57^63^69^75;;1^41^5^5^5^5^5^5
- 56 ;;45^67;;12C^13C
- 57 ;;1^3^12^21^24^35^58;;1^8^8^1^10C^22^22
- 58 ;;0;;39C
- 59 ;;0^40^49^59^63^72;;39C^8^9^4^8^8C
- 61 ;;0^40^51^55^59^63^72;;39C^10^3^3^3^8^8
- 63 ;;0^47^70;;39C^20^9
- ABMDF1X ; IHS/ASDST/DMJ - PRINT UB82 ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;TMD;
- +3 ;
- +4 KILL ABM
- +5 USE IO
- +6 ;
- MARG ;Set left and top margins
- +1 WRITE $$EN^ABMVDF("IOF")
- +2 SET U="^"
- SET (ABM("LM"),ABM("TM"),ABM("LN"))=0
- +3 IF $DATA(^ABMDEXP(1,0))
- SET ABM("LM")=$PIECE(^(0),U,2)
- SET ABM("TM")=$PIECE(^(0),U,3)
- +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")>63)
- GOTO XIT
- +1 ;
- +2 ;Check for invalid line numbers
- +3 FOR ABM("I")=7,9,40,45
- IF ABM("I")=ABM("LN")
- QUIT
- +4 IF $TEST
- GOTO LOOP
- +5 ;
- +6 ;Set to correct format line
- +7 SET ABM("FL")=$SELECT(ABM("LN")=1:2,ABM("LN")=3:4,ABM("LN")=5:6,ABM("LN")=11:12,ABM("LN")=13:14,ABM("LN")=15:14,ABM("LN")>17&(ABM("LN")<40):17,ABM("LN")=42:41,ABM("LN")=43:41,ABM("LN")=47:46,1:99)
- +8 IF ABM("FL")=99
- SET ABM("FL")=$SELECT(ABM("LN")=48:46,ABM("LN")=49:50,ABM("LN")=51:50,ABM("LN")=58:59,ABM("LN")=60:61,ABM("LN")=62:63,1:ABM("LN"))
- +9 ;
- +10 ;Set tab & format variables
- +11 SET ABM("TABS")=$PIECE($TEXT(@ABM("FL")),";;",2)
- +12 SET ABM("FMAT")=$PIECE($TEXT(@ABM("FL")),";;",3)
- +13 ;
- +14 ;Skip to req'd line
- +15 FOR
- IF $Y-ABM("TM")>(ABM("LN")-2)
- QUIT
- WRITE !
- +16 ;
- +17 ; Test Modes for setting Data Fields
- +18 IF '$DATA(ABMF("TEST"))
- GOTO LOOP2
- +19 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
- +20 GOTO LOOP
- +21 ;
- +22 ;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")["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")
- +3 IF ABM("LTH")["C"
- SET ABM("LTH")=$PIECE(ABM("LTH"),"C")
- SET ABM("CTR")=(ABM("LTH")-$LENGTH(ABM("FLD")))\2
- IF ABM("CTR")>1
- SET ABM("BLNK")=""
- SET $PIECE(ABM("BLNK")," ",ABM("CTR"))=""
- SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
- +4 IF ABM("LTH")["R"
- SET ABM("LTH")=$PIECE(ABM("LTH"),"R")
- SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))
- IF ABM("RT")>1
- SET ABM("BLNK")=""
- SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""
- SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
- +5 WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))
- +6 QUIT
- +7 ;
- TEST SET ABMF("TEST")=1
- +1 FOR ABM=0:ABMF("TEST"):60
- SET ABMF(ABM)=""
- +2 GOTO MARG
- +3 ;
- XIT KILL ABMF,ABM
- +1 QUIT
- +2 ;
- TEXT ;;TABS;;FIELD LENGTH/FORMAT ($-$ FORMAT,L-LNTH REQ'D,C-CENTER,R-RIGHT)
- 2 ;;0^26^58^77;;25^31C^17C^3
- 4 ;;0^26^40^51^60^73;;25^13C^10C^8C^12C^6C
- 6 ;;0^32;;30^47C
- 8 ;;0^9^12^14^23^26^29^31^34^37^40^49^58^62^66^69^72;;8^1^1^8^2L^1^1^2L^2L^2L^8^8^3C^3C^2^2^8C
- 10 ;;0^3^12^15^24^27^36^39^48^51^60^63^72;;2L^8^2L^8^2L^8^2L^8^2L^8^2L^8^8
- 12 ;;0^32^35^38^41^44^47^50^53^57^60^63;;31^2L^2L^2L^2L^2L^2^2^2^1^2L^17C
- 14 ;;0^32^35^44^47^56^59^68^71;;31^2L^8$^2L^8$^2L^8$
- 16 ;;51^61^71;;9C^9C^9C
- 17 ;;0^25^33^37^41^51^61^71;;24^7^3^3C^9$^9$^9$^9$
- 41 ;;0^26^29^31^41^51^61^71;;25^1^1^9$^9$^9$^9$^9$
- 44 ;;51^61^71;;9$^9$^9$
- 46 ;;0^25^28^31^48^63;;24^1^2L^16C^14^17C
- 50 ;;0^3^6^31^43;;2^1^24^11^37
- 52 ;;19;;26
- 53 ;;0^46^53^60^67^74;;45^6^6^6^6
- 54 ;;22;;22
- 55 ;;1^3^45^51^57^63^69^75;;1^41^5^5^5^5^5^5
- 56 ;;45^67;;12C^13C
- 57 ;;1^3^12^21^24^35^58;;1^8^8^1^10C^22^22
- 58 ;;0;;39C
- 59 ;;0^40^49^59^63^72;;39C^8^9^4^8^8C
- 61 ;;0^40^51^55^59^63^72;;39C^10^3^3^3^8^8
- 63 ;;0^47^70;;39C^20^9
