ABMDRAL ; IHS/ASDST/DMJ - Bill Listing ;
;;2.6;IHS 3P BILLING SYSTEM;**4,9,14,21**;NOV 12, 2009;Build 379
;Original;TMD;
; IHS/SD/SDR -abm*2.6*4 - HEAT12210 - put subscripts in the correct order
; IHS/SD/SDR - 2.6*9 - HEAT35406 - Correction to itemized report
;IHS/SD/SDR - 2.6*21 - HEAT112271 - Changed report from PAID to POSTED. It doesn't look for a pymt specifically,
; just that something is in the 3 multiple of the bill.
;
K ABM,ABMY
K DIR
;S DIR(0)="SO^1:UNPAID BILLS;2:PAID BILLS;3:ALL BILLS;4:INCOMPLETE BILLS" ;abm*2.6*21 IHS/SD/SDR HEAT112271
S DIR(0)="SO^1:UNPAID BILLS;2:POSTED BILLS;3:ALL BILLS;4:INCOMPLETE BILLS" ;abm*2.6*21 IHS/SD/SDR HEAT112271
S DIR("B")=3,DIR("A")="Select TYPE of REPORT"
D ^DIR K DIR Q:$D(DIRUT) S ABMP("TYP")=+Y-1
S:ABMP("TYP")=3 ABMP("COMPL")=1
I ABMP("TYP")>0 S ABM("PAY")="",ABM("COST")=""
E S ABM("OVER-DUE")=""
S ABM("RTYP")=1,ABM("RTYP","NM")="BRIEF LISTING (80 Width)" D ^ABMDRSEL G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HD ;S ABM("HD",0)="LISTING of "_$S(ABMP("TYP")=0:"UNPAID",ABMP("TYP")=1:"PAID",ABMP("TYP")=3:"INCOMPLETE",1:"ALL")_" BILLS" D ^ABMDRHD G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT) ;abm*2.6*9 HEAT35406
;S ABM("HD",0)="LISTING of "_$S(ABMP("TYP")=0:"UNPAID",ABMP("TYP")=1:"PAID",ABMP("TYP")=3:"INCOMPLETE",1:"ALL")_" BILLS" G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT) ;abm*2.6*9 HEAT35406 ;abm*2.6*21 IHS/SD/SDR HEAT112271
S ABM("HD",0)="LISTING of "_$S(ABMP("TYP")=0:"UNPAID",ABMP("TYP")=1:"POSTED",ABMP("TYP")=3:"INCOMPLETE",1:"ALL")_" BILLS" G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT) ;abm*2.6*9 HEAT35406 ;abm*2.6*21 IHS/SD/SDR HEAT112271
S ABMQ("RC")="COMPUTE^ABMDRAL",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"
I 'ABMP("TYP") S ABMQ("RP")="PRINT^ABMDRUN"_ABM("RTYP")
E S ABMQ("RP")="PRINT^ABMDRAL"_ABM("RTYP")
D ^ABMDRDBQ
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
S ABM("SUBR")="ABM-AL" K ^TMP(ABM("SUBR"),$J),^TMP("ABM-AL",$J,"ST")
S ABMP("RTN")="ABMDRAL" D LOOP^ABMDRUTL
Q
;
DATA S ABMP("HIT")=0 D ^ABMDRCHK Q:'ABMP("HIT")
S ABM("S1")=$S(ABMY("SORT")="C":ABM("C"),1:ABM("V"))
S ABM("S2")=$S(ABM("RTYP")=3:0,1:$P(^AUTNINS(ABM("I"),0),U))
S ABM("S3")=$S(ABM("RTYP")=3:0,1:ABM)
S ABM("L")=$P(^DIC(4,ABM("L"),0),U)
G STAT:ABM("RTYP")>2
S ^TMP("ABM-AL",$J,$E(ABM("L"),1,18)_U_ABM("S1")_U_$E(ABM("S2"),1,18)_U_$E($P(^DPT(ABM("P"),0),U),1,18)_U_ABM)=""
Q
;
STAT I '$D(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3"))) S ^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3"))=""
;S $P(^TMP("ABM-AL","ST",$J,ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)+1 ;abm*2.6*4 HEAT12210
S $P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)+1 ;abm*2.6*4 HEAT12210
S $P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)+$P($G(^ABMDBILL(DUZ(2),ABM,2)),U)
Q:'ABMP("TYP")
;
PREV S (ABM("J"),ABM("PD"),ABM("DEDCT"))=0
F S ABM("J")=$O(^ABMDBILL(DUZ(2),ABM,3,ABM("J"))) Q:'ABM("J") S ABM("PDD")=+^(ABM("J"),0) D
.I $G(ABMY("DT"))="P",ABM("PDD")<ABMY("DT",1)!(ABM("PDD")>ABMY("DT",2)) Q
.S ABM("PD")=$P(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0),U,2)+ABM("PD"),ABM("DEDCT")=ABM("DEDCT")+$P(^(0),U,3)+$P(^(0),U,4)
S (ABM("WO"),ABM("OB"))=0
I $P(^ABMDBILL(DUZ(2),ABM,0),U,4)="C" S ABM("WO")=^(2)-ABM("PD")-ABM("DEDCT")
E S ABM("OB")=$P(^ABMDBILL(DUZ(2),ABM,2),U)-ABM("PD")-ABM("DEDCT")
I ABM("WO")<0 S ABM("OB")=ABM("WO"),ABM("WO")=0
S $P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)+ABM("PD")
S $P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)+ABM("DEDCT")
S $P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)+ABM("WO")
S $P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)+ABM("OB")
Q
;
XIT K ABM,ABMY,ABMP
Q
ABMDRAL ; IHS/ASDST/DMJ - Bill Listing ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**4,9,14,21**;NOV 12, 2009;Build 379
+2 ;Original;TMD;
+3 ; IHS/SD/SDR -abm*2.6*4 - HEAT12210 - put subscripts in the correct order
+4 ; IHS/SD/SDR - 2.6*9 - HEAT35406 - Correction to itemized report
+5 ;IHS/SD/SDR - 2.6*21 - HEAT112271 - Changed report from PAID to POSTED. It doesn't look for a pymt specifically,
+6 ; just that something is in the 3 multiple of the bill.
+7 ;
+8 KILL ABM,ABMY
+9 KILL DIR
+10 ;S DIR(0)="SO^1:UNPAID BILLS;2:PAID BILLS;3:ALL BILLS;4:INCOMPLETE BILLS" ;abm*2.6*21 IHS/SD/SDR HEAT112271
+11 ;abm*2.6*21 IHS/SD/SDR HEAT112271
SET DIR(0)="SO^1:UNPAID BILLS;2:POSTED BILLS;3:ALL BILLS;4:INCOMPLETE BILLS"
+12 SET DIR("B")=3
SET DIR("A")="Select TYPE of REPORT"
+13 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
SET ABMP("TYP")=+Y-1
+14 IF ABMP("TYP")=3
SET ABMP("COMPL")=1
+15 IF ABMP("TYP")>0
SET ABM("PAY")=""
SET ABM("COST")=""
+16 IF '$TEST
SET ABM("OVER-DUE")=""
+17 SET ABM("RTYP")=1
SET ABM("RTYP","NM")="BRIEF LISTING (80 Width)"
DO ^ABMDRSEL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
HD ;S ABM("HD",0)="LISTING of "_$S(ABMP("TYP")=0:"UNPAID",ABMP("TYP")=1:"PAID",ABMP("TYP")=3:"INCOMPLETE",1:"ALL")_" BILLS" D ^ABMDRHD G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT) ;abm*2.6*9 HEAT35406
+1 ;S ABM("HD",0)="LISTING of "_$S(ABMP("TYP")=0:"UNPAID",ABMP("TYP")=1:"PAID",ABMP("TYP")=3:"INCOMPLETE",1:"ALL")_" BILLS" G XIT:'$D(IO)!$G(POP)!$D(DTOUT)!$D(DUOUT) ;abm*2.6*9 HEAT35406 ;abm*2.6*21 IHS/SD/SDR HEAT112271
+2 ;abm*2.6*9 HEAT35406 ;abm*2.6*21 IHS/SD/SDR HEAT112271
SET ABM("HD",0)="LISTING of "_$SELECT(ABMP("TYP")=0:"UNPAID",ABMP("TYP")=1:"POSTED",ABMP("TYP")=3:"INCOMPLETE",1:"ALL")_" BILLS"
IF '$DATA(IO)!$GET(POP)!$DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
+3 SET ABMQ("RC")="COMPUTE^ABMDRAL"
SET ABMQ("RX")="POUT^ABMDRUTL"
SET ABMQ("NS")="ABM"
+4 IF 'ABMP("TYP")
SET ABMQ("RP")="PRINT^ABMDRUN"_ABM("RTYP")
+5 IF '$TEST
SET ABMQ("RP")="PRINT^ABMDRAL"_ABM("RTYP")
+6 DO ^ABMDRDBQ
+7 QUIT
+8 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABM("SUBR")="ABM-AL"
KILL ^TMP(ABM("SUBR"),$JOB),^TMP("ABM-AL",$JOB,"ST")
+2 SET ABMP("RTN")="ABMDRAL"
DO LOOP^ABMDRUTL
+3 QUIT
+4 ;
DATA SET ABMP("HIT")=0
DO ^ABMDRCHK
IF 'ABMP("HIT")
QUIT
+1 SET ABM("S1")=$SELECT(ABMY("SORT")="C":ABM("C"),1:ABM("V"))
+2 SET ABM("S2")=$SELECT(ABM("RTYP")=3:0,1:$PIECE(^AUTNINS(ABM("I"),0),U))
+3 SET ABM("S3")=$SELECT(ABM("RTYP")=3:0,1:ABM)
+4 SET ABM("L")=$PIECE(^DIC(4,ABM("L"),0),U)
+5 IF ABM("RTYP")>2
GOTO STAT
+6 SET ^TMP("ABM-AL",$JOB,$EXTRACT(ABM("L"),1,18)_U_ABM("S1")_U_$EXTRACT(ABM("S2"),1,18)_U_$EXTRACT($PIECE(^DPT(ABM("P"),0),U),1,18)_U_ABM)=""
+7 QUIT
+8 ;
STAT IF '$DATA(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")))
SET ^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3"))=""
+1 ;S $P(^TMP("ABM-AL","ST",$J,ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)=$P(^TMP("ABM-AL",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)+1 ;abm*2.6*4 HEAT12210
+2 ;abm*2.6*4 HEAT12210
SET $PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)=$PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)+1
+3 SET $PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)=$PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,2)),U)
+4 IF 'ABMP("TYP")
QUIT
+5 ;
PREV SET (ABM("J"),ABM("PD"),ABM("DEDCT"))=0
+1 FOR
SET ABM("J")=$ORDER(^ABMDBILL(DUZ(2),ABM,3,ABM("J")))
IF 'ABM("J")
QUIT
SET ABM("PDD")=+^(ABM("J"),0)
Begin DoDot:1
+2 IF $GET(ABMY("DT"))="P"
IF ABM("PDD")<ABMY("DT",1)!(ABM("PDD")>ABMY("DT",2))
QUIT
+3 SET ABM("PD")=$PIECE(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0),U,2)+ABM("PD")
SET ABM("DEDCT")=ABM("DEDCT")+$PIECE(^(0),U,3)+$PIECE(^(0),U,4)
End DoDot:1
+4 SET (ABM("WO"),ABM("OB"))=0
+5 IF $PIECE(^ABMDBILL(DUZ(2),ABM,0),U,4)="C"
SET ABM("WO")=^(2)-ABM("PD")-ABM("DEDCT")
+6 IF '$TEST
SET ABM("OB")=$PIECE(^ABMDBILL(DUZ(2),ABM,2),U)-ABM("PD")-ABM("DEDCT")
+7 IF ABM("WO")<0
SET ABM("OB")=ABM("WO")
SET ABM("WO")=0
+8 SET $PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)=$PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)+ABM("PD")
+9 SET $PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)=$PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)+ABM("DEDCT")
+10 SET $PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)=$PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)+ABM("WO")
+11 SET $PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)=$PIECE(^TMP("ABM-AL",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)+ABM("OB")
+12 QUIT
+13 ;
XIT KILL ABM,ABMY,ABMP
+1 QUIT
