- 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
