ABMDF1D ; IHS/ASDST/DMJ - Set UB82 Print Array - Part 4 ;
;;2.6;IHS 3P BILLING SYSTEM;**6**;NOV 12, 2009
;Original;TMD;
;
S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
D ^ABMDESM1
I $D(ABMP("FLAT")) S ABMF(16)="NON-CVD"
S ABMS="" F I=17:1:39 S ABMS=$O(ABMS(ABMS)) Q:'ABMS D
.S ABMF(I)=$S($P($G(ABMP("FLAT")),U,6)]"":$P(ABMP("FLAT"),U,6),1:$P($G(^AUTTREVN(ABMS,0)),U,2))
.S $P(ABMF(I),U,2)=$S($D(ABMS("CPT")):$P(ABMS("CPT",1),U,2),$P($G(ABMP("FLAT")),U,7)]"":$P(ABMP("FLAT"),U,7),$P(ABMS(ABMS),U,3)]"":$J($P(ABMS(ABMS),U,3),7,2),1:"")
.I $P(ABMS(ABMS),U,3)=""&($P(ABMS(ABMS),U,4)]"") S $P(ABMF(I),U,2)=$P(ABMS(ABMS),U,4)
.S $P(ABMF(I),U,3)=ABMS
.S $P(ABMF(I),U,4)=$P(ABMS(ABMS),U,2)
.S $P(ABMF(I),U,5)=$P(ABMS(ABMS),U)
.S $P(ABMF(I),U,6)=$P(ABMS(ABMS),U,5)
I '+ABMS,$D(ABMS("CPT")) S ABMS=1 F I=I:1:39 S ABMS=$O(ABMS("CPT",ABMS)) Q:ABMS="" D
.S ABMF(I)=$P(ABMS("CPT",ABMS),U)_U_$P(ABMS("CPT",ABMS),U,2)_U_$P(ABMS("CPT",ABMS),U,3)_U_$P(ABMS("CPT",ABMS),U,4)_U_$P(ABMS("CPT",ABMS),U,5)
;
I I=39,+ABMS K ABMF("C") F I=39:1 S ABMS=$O(ABMS(ABMS)) Q:'ABMS D
.S ABMR(I)=$P($G(^AUTTREVN(ABMS,0)),U,2)
.I $P(ABMS(ABMS),U,3)]"" S $P(ABMR(I),U,2)=$J($P(ABMS(ABMS),U,3),7,2)
.I $P(ABMS(ABMS),U,3)=""&($P(ABMS(ABMS),U,4)]"") S $P(ABMR(I),U,2)=$P(ABMS(ABMS),U,4)
.S $P(ABMR(I),U,3)=ABMS
.S $P(ABMR(I),U,4)=$P(ABMS(ABMS),U,2)
.S $P(ABMR(I),U,5)=$P(ABMS(ABMS),U)
.S $P(ABMR(I),U,6)=$P(ABMS(ABMS),U,5)
.Q
I I=39 S $P(ABMF(I),U,1)=" TOTAL CHARGES"_U_U_"001"_U_U_ABMS("TOT")
I I<39 S $P(ABMF(I+1),U,1)=" TOTAL CHARGES"_U_U_"001"_U_U_ABMS("TOT")
E S ABMR("TOT")=" TOTAL CHARGES"_U_U_"001"_U_U_ABMS("TOT")
;
S ABM("P8")=ABMS("TOT")-ABMP("PAID")-ABMP("TW")
I $D(ABMP("FLAT")) S ABM("P8")=ABM("P8")-$P(ABMS($O(ABMS(0))),U,5)
I ABM("P8")<0 S ABM("P8")=0
;I ABMP("PAYOR")=44 S $P(ABMF(44),U)=ABM("P8")+$P(ABMF(44),U,2),$P(ABMF(44),U,3)=ABM("P8") S:$P(ABMF(44),U,2)="" $P(ABMF(44),U,2)=0 ;IHS/SD/AML NOHEAT 2/15/2011
;E S $P(ABMF(ABMP("PAYOR")),U,6)=ABM("P8")+$P(ABMF(ABMP("PAYOR")),U,7),$P(ABMF(ABMP("PAYOR")),U,8)=ABM("P8") S:$P(ABMF(ABMP("PAYOR")),U,2)="" $P(ABMF(ABMP("PAYOR")),U,2)=0 ;IHS/SD/AML NOHEAT 2/15/2011
S $P(ABMY("TOT"),U,2)=$P(ABMY("TOT"),U,2)+ABM("P8")
I '$D(ABMY("TINS",$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8))) S ABMY("TINS",$P(^(0),U,8))="",$P(ABMY("TOT"),U,3)=$P(ABMY("TOT"),U,3)+1
K ABMS
;
G ^ABMDF1E
ABMDF1D ; IHS/ASDST/DMJ - Set UB82 Print Array - Part 4 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6**;NOV 12, 2009
+2 ;Original;TMD;
+3 ;
+4 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+5 DO ^ABMDESM1
+6 IF $DATA(ABMP("FLAT"))
SET ABMF(16)="NON-CVD"
+7 SET ABMS=""
FOR I=17:1:39
SET ABMS=$ORDER(ABMS(ABMS))
IF 'ABMS
QUIT
Begin DoDot:1
+8 SET ABMF(I)=$SELECT($PIECE($GET(ABMP("FLAT")),U,6)]"":$PIECE(ABMP("FLAT"),U,6),1:$PIECE($GET(^AUTTREVN(ABMS,0)),U,2))
+9 SET $PIECE(ABMF(I),U,2)=$SELECT($DATA(ABMS("CPT")):$PIECE(ABMS("CPT",1),U,2),$PIECE($GET(ABMP("FLAT")),U,7)]"":$PIECE(ABMP("FLAT"),U,7),$PIECE(ABMS(ABMS),U,3)]"":$JUSTIFY($PIECE(ABMS(ABMS),U,3),7,2),1:"")
+10 IF $PIECE(ABMS(ABMS),U,3)=""&($PIECE(ABMS(ABMS),U,4)]"")
SET $PIECE(ABMF(I),U,2)=$PIECE(ABMS(ABMS),U,4)
+11 SET $PIECE(ABMF(I),U,3)=ABMS
+12 SET $PIECE(ABMF(I),U,4)=$PIECE(ABMS(ABMS),U,2)
+13 SET $PIECE(ABMF(I),U,5)=$PIECE(ABMS(ABMS),U)
+14 SET $PIECE(ABMF(I),U,6)=$PIECE(ABMS(ABMS),U,5)
End DoDot:1
+15 IF '+ABMS
IF $DATA(ABMS("CPT"))
SET ABMS=1
FOR I=I:1:39
SET ABMS=$ORDER(ABMS("CPT",ABMS))
IF ABMS=""
QUIT
Begin DoDot:1
+16 SET ABMF(I)=$PIECE(ABMS("CPT",ABMS),U)_U_$PIECE(ABMS("CPT",ABMS),U,2)_U_$PIECE(ABMS("CPT",ABMS),U,3)_U_$PIECE(ABMS("CPT",ABMS),U,4)_U_$PIECE(ABMS("CPT",ABMS),U,5)
End DoDot:1
+17 ;
+18 IF I=39
IF +ABMS
KILL ABMF("C")
FOR I=39:1
SET ABMS=$ORDER(ABMS(ABMS))
IF 'ABMS
QUIT
Begin DoDot:1
+19 SET ABMR(I)=$PIECE($GET(^AUTTREVN(ABMS,0)),U,2)
+20 IF $PIECE(ABMS(ABMS),U,3)]""
SET $PIECE(ABMR(I),U,2)=$JUSTIFY($PIECE(ABMS(ABMS),U,3),7,2)
+21 IF $PIECE(ABMS(ABMS),U,3)=""&($PIECE(ABMS(ABMS),U,4)]"")
SET $PIECE(ABMR(I),U,2)=$PIECE(ABMS(ABMS),U,4)
+22 SET $PIECE(ABMR(I),U,3)=ABMS
+23 SET $PIECE(ABMR(I),U,4)=$PIECE(ABMS(ABMS),U,2)
+24 SET $PIECE(ABMR(I),U,5)=$PIECE(ABMS(ABMS),U)
+25 SET $PIECE(ABMR(I),U,6)=$PIECE(ABMS(ABMS),U,5)
+26 QUIT
End DoDot:1
+27 IF I=39
SET $PIECE(ABMF(I),U,1)=" TOTAL CHARGES"_U_U_"001"_U_U_ABMS("TOT")
+28 IF I<39
SET $PIECE(ABMF(I+1),U,1)=" TOTAL CHARGES"_U_U_"001"_U_U_ABMS("TOT")
+29 IF '$TEST
SET ABMR("TOT")=" TOTAL CHARGES"_U_U_"001"_U_U_ABMS("TOT")
+30 ;
+31 SET ABM("P8")=ABMS("TOT")-ABMP("PAID")-ABMP("TW")
+32 IF $DATA(ABMP("FLAT"))
SET ABM("P8")=ABM("P8")-$PIECE(ABMS($ORDER(ABMS(0))),U,5)
+33 IF ABM("P8")<0
SET ABM("P8")=0
+34 ;I ABMP("PAYOR")=44 S $P(ABMF(44),U)=ABM("P8")+$P(ABMF(44),U,2),$P(ABMF(44),U,3)=ABM("P8") S:$P(ABMF(44),U,2)="" $P(ABMF(44),U,2)=0 ;IHS/SD/AML NOHEAT 2/15/2011
+35 ;E S $P(ABMF(ABMP("PAYOR")),U,6)=ABM("P8")+$P(ABMF(ABMP("PAYOR")),U,7),$P(ABMF(ABMP("PAYOR")),U,8)=ABM("P8") S:$P(ABMF(ABMP("PAYOR")),U,2)="" $P(ABMF(ABMP("PAYOR")),U,2)=0 ;IHS/SD/AML NOHEAT 2/15/2011
+36 SET $PIECE(ABMY("TOT"),U,2)=$PIECE(ABMY("TOT"),U,2)+ABM("P8")
+37 IF '$DATA(ABMY("TINS",$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8)))
SET ABMY("TINS",$PIECE(^(0),U,8))=""
SET $PIECE(ABMY("TOT"),U,3)=$PIECE(ABMY("TOT"),U,3)+1
+38 KILL ABMS
+39 ;
+40 GOTO ^ABMDF1E
