- 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
