ABMDF2 ; IHS/ASDST/DMJ - Set HCFA-1500 Print Array ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;
;
K ABMP S U="^",ABMP("XMIT")=0,ABMP("EXP")=2,ABMY("TOT")="0^0^0"
BDFN S ABMY("N")=0 F S ABMY("N")=$O(ABMY(ABMY("N"))) Q:'ABMY("N") D
.S ABMP("BDFN")="" F S ABMP("BDFN")=$O(ABMY(ABMY("N"),ABMP("BDFN"))) Q:'ABMP("BDFN") D
..Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
..D ENT
..I +$O(ABMR("")) S ABMR("MORE")=""
..D ^ABMDF2X
..I +$O(ABMR("")) D HCFA
XMIT ..I ABMP("XMIT")=0 S ABM("XM")="" F S ABM("XM")=$O(^ABMDTXST(DUZ(2),"B",DT,ABM("XM"))) Q:'ABM("XM") D Q:ABMP("XMIT")
...Q:'$D(^ABMDTXST(DUZ(2),ABM("XM"),0)) Q:$P(^(0),U,2)'=ABMP("EXP")
...I $D(ABMY("TYP")),$P(^ABMDTXST(DUZ(2),ABM("XM"),0),U,3)=ABMY("TYP") S ABMP("XMIT")=ABM("XM")
...I $D(ABMY("INS")),$P(^ABMDTXST(DUZ(2),ABM("XM"),0),U,4)=ABMY("INS") S ABMP("XMIT")=ABM("XM")
..I '+ABMP("XMIT") S DIC="^ABMDTXST(DUZ(2),",DIC(0)="L",X=DT,DIC("DR")=".02////2;.07////1;.08////1;"_$S($D(ABMY("TYP")):".03////"_$P(ABMY("TYP"),U),$D(ABMY("INS")):".04////"_ABMY("INS"),1:".03////A")_";.05////"_DUZ
..I K DD,DO D FILE^DICN S ABMP("XMIT")=+Y
..S DIE="^ABMDBILL(DUZ(2),",DA=ABMP("BDFN"),DR=".04////B;.16////A;.17////"_ABMP("XMIT") D ^ABMDDIE Q:$D(ABM("DIE-FAIL"))
..K ^ABMDBILL(DUZ(2),"AS",+^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"A",ABMP("BDFN")),^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN"))
..S ABM=ABMP("BDFN"),ABM("L")=ABMP("XMIT") K ABMP S ABMP("XMIT")=ABM("L"),ABMP("BDFN")=ABM
G XIT
;
HCFA ;EP for printing HCFA 1500's
S ABMR="" F ABMR("I")=37:2:47 S ABMR=$O(ABMR(ABMR)) Q:'ABMR D
.S ABMF(ABMR("I"))=$P(ABMR(ABMR),U,2)_U_$S(ABMP("VTYP")=111!($G(ABMP("BTYP"))=111):1,1:3)_U_$P(ABMR(ABMR),U,4)_U_U_$P(ABMR(ABMR),U,5)_U_$P(ABMR(ABMR),U)_U_$P(ABMR(ABMR),U,6)_U_$P(ABMR(ABMR),U,7)
.S ABMF(ABMR("I")+1)=""
.I $P(ABMR(ABMR),U,2)'=$P(ABMR(ABMR),U,3) S ABMF(ABMR("I")+1)=$P(ABMR(ABMR),U,3)
.I $L($P(ABMR(ABMR),U,8))>19 S ABMU("LNG")=19,ABMU("TXT")=$P(ABMR(ABMR),U,8),ABMU=2 D LNG^ABMDWRAP S $P(ABMF(ABMR("I")),U,4)=ABMU(1),$P(ABMF(ABMR("I")+1),U,4)=ABMU(2) K ABMU I 1
.E S $P(ABMF(ABMR("I")),U,4)=$P(ABMR(ABMR),U,8)
.K ABMR(ABMR)
.Q
I ABMR("I")=47,+$O(ABMR(ABMR)) D ^ABMDF2X G HCFA
S ABMF(50)=$S($D(ABMF(50)):ABMF(50),1:"")_ABMR("TOT")
S $P(ABMF(50),U,3)=$S($P(ABMF(50),U,3)>999:$FN($P(ABMF(50),U,3),",",0),1:$FN($P(ABMF(50),U,3),",",2))
I ABMR("I")'=47 F ABMR("I")=ABMR("I"):1:48 K ABMF(ABMR("I"))
K ABMR("MORE")
D ^ABMDF2X
Q
;
ENT ;EP for setting up export array
D ^ABMDF2A
G ^ABMDF2B
;
XIT K ABM,ABMV,ABMF
Q
ABMDF2 ; IHS/ASDST/DMJ - Set HCFA-1500 Print Array ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;
+3 ;
+4 KILL ABMP
SET U="^"
SET ABMP("XMIT")=0
SET ABMP("EXP")=2
SET ABMY("TOT")="0^0^0"
BDFN SET ABMY("N")=0
FOR
SET ABMY("N")=$ORDER(ABMY(ABMY("N")))
IF 'ABMY("N")
QUIT
Begin DoDot:1
+1 SET ABMP("BDFN")=""
FOR
SET ABMP("BDFN")=$ORDER(ABMY(ABMY("N"),ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:2
+2 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
QUIT
+3 DO ENT
+4 IF +$ORDER(ABMR(""))
SET ABMR("MORE")=""
+5 DO ^ABMDF2X
+6 IF +$ORDER(ABMR(""))
DO HCFA
XMIT IF ABMP("XMIT")=0
SET ABM("XM")=""
FOR
SET ABM("XM")=$ORDER(^ABMDTXST(DUZ(2),"B",DT,ABM("XM")))
IF 'ABM("XM")
QUIT
Begin DoDot:3
+1 IF '$DATA(^ABMDTXST(DUZ(2),ABM("XM"),0))
QUIT
IF $PIECE(^(0),U,2)'=ABMP("EXP")
QUIT
+2 IF $DATA(ABMY("TYP"))
IF $PIECE(^ABMDTXST(DUZ(2),ABM("XM"),0),U,3)=ABMY("TYP")
SET ABMP("XMIT")=ABM("XM")
+3 IF $DATA(ABMY("INS"))
IF $PIECE(^ABMDTXST(DUZ(2),ABM("XM"),0),U,4)=ABMY("INS")
SET ABMP("XMIT")=ABM("XM")
End DoDot:3
IF ABMP("XMIT")
QUIT
+4 IF '+ABMP("XMIT")
SET DIC="^ABMDTXST(DUZ(2),"
SET DIC(0)="L"
SET X=DT
SET DIC("DR")=".02////2;.07////1;.08////1;"_$SELECT($DATA(ABMY("TYP")):".03////"_$PIECE(ABMY("TYP"),U),$DATA(ABMY("INS")):".04////"_ABMY("INS"),1:".03////A")_";.05////"_DUZ
+5 IF $TEST
KILL DD,DO
DO FILE^DICN
SET ABMP("XMIT")=+Y
+6 SET DIE="^ABMDBILL(DUZ(2),"
SET DA=ABMP("BDFN")
SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")
DO ^ABMDDIE
IF $DATA(ABM("DIE-FAIL"))
QUIT
+7 KILL ^ABMDBILL(DUZ(2),"AS",+^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"A",ABMP("BDFN")),^ABMDBILL(DUZ(2),"AC","A",ABMP("BDFN"))
+8 SET ABM=ABMP("BDFN")
SET ABM("L")=ABMP("XMIT")
KILL ABMP
SET ABMP("XMIT")=ABM("L")
SET ABMP("BDFN")=ABM
End DoDot:2
End DoDot:1
+9 GOTO XIT
+10 ;
HCFA ;EP for printing HCFA 1500's
+1 SET ABMR=""
FOR ABMR("I")=37:2:47
SET ABMR=$ORDER(ABMR(ABMR))
IF 'ABMR
QUIT
Begin DoDot:1
+2 SET ABMF(ABMR("I"))=$PIECE(ABMR(ABMR),U,2)_U_$SELECT(ABMP("VTYP")=111!($GET(ABMP("BTYP"))=111):1,1:3)_U_$PIECE(ABMR(ABMR),U,4)_U_U_$PIECE(ABMR(ABMR),U,5)_U_$PIECE(ABMR(ABMR),U)_U_$PIECE(ABMR(ABMR),U,6)_U_$PIECE(ABMR(ABMR),U,7)
+3 SET ABMF(ABMR("I")+1)=""
+4 IF $PIECE(ABMR(ABMR),U,2)'=$PIECE(ABMR(ABMR),U,3)
SET ABMF(ABMR("I")+1)=$PIECE(ABMR(ABMR),U,3)
+5 IF $LENGTH($PIECE(ABMR(ABMR),U,8))>19
SET ABMU("LNG")=19
SET ABMU("TXT")=$PIECE(ABMR(ABMR),U,8)
SET ABMU=2
DO LNG^ABMDWRAP
SET $PIECE(ABMF(ABMR("I")),U,4)=ABMU(1)
SET $PIECE(ABMF(ABMR("I")+1),U,4)=ABMU(2)
KILL ABMU
IF 1
+6 IF '$TEST
SET $PIECE(ABMF(ABMR("I")),U,4)=$PIECE(ABMR(ABMR),U,8)
+7 KILL ABMR(ABMR)
+8 QUIT
End DoDot:1
+9 IF ABMR("I")=47
IF +$ORDER(ABMR(ABMR))
DO ^ABMDF2X
GOTO HCFA
+10 SET ABMF(50)=$SELECT($DATA(ABMF(50)):ABMF(50),1:"")_ABMR("TOT")
+11 SET $PIECE(ABMF(50),U,3)=$SELECT($PIECE(ABMF(50),U,3)>999:$FNUMBER($PIECE(ABMF(50),U,3),",",0),1:$FNUMBER($PIECE(ABMF(50),U,3),",",2))
+12 IF ABMR("I")'=47
FOR ABMR("I")=ABMR("I"):1:48
KILL ABMF(ABMR("I"))
+13 KILL ABMR("MORE")
+14 DO ^ABMDF2X
+15 QUIT
+16 ;
ENT ;EP for setting up export array
+1 DO ^ABMDF2A
+2 GOTO ^ABMDF2B
+3 ;
XIT KILL ABM,ABMV,ABMF
+1 QUIT
