ABMDRPT ; IHS/ASDST/DMJ - Bill Listing ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;
;
K ABM,ABMY S ABM("PAY")="",ABMP("TYP")=3
S ABM("PRIVACY")=1,ABM("COST")=""
SEL S DIC="^AUPNPAT(",DIC(0)="QEAM" D ^DIC G XIT:X=""!$D(DTOUT)!$D(DUOUT),SEL:+Y<1 S ABM("PAT")=+Y
W ! K DIR
S DIR(0)="YO",DIR("A")="Screen out BILLS that are COMPLETED"
S DIR("?")="Answer YES if those Bills that are in a Completed Status (unobligated balance equal to zero) are to be screened out (not included)."
S DIR("B")="N" D ^DIR G XIT:$D(DIRUT)!$D(DIROUT)
S ABMP("COMPL")=+Y
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)="BILLING ACTIVITY of "_$P(^DPT(ABM("PAT"),0),U)
D ^ABMDRHD
S ABMQ("RC")="COMPUTE^ABMDRPT",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"
I ABM("RTYP")<3 S ABMQ("RP")="PRINT^ABMDRPT"_ABM("RTYP")
E S ABMQ("RP")="PRINT^ABMDRAL"_ABM("RTYP")
;S ABM("$J")=DUZ_"-"_$P($H,",",1)_"-"_$P($H,",",2)
D ^ABMDRDBQ
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
S ABM("SUBR")="ABM-PT" K ^TMP("ABM-PT",$J),^TMP("ABM-PT",$J,"ST")
PAT S ABM="" F S ABM=$O(^ABMDBILL(DUZ(2),"D",ABM("PAT"),ABM)) Q:'ABM D DATA
Q
;
DATA S ABMP("HIT")=0 D ^ABMDRCHK Q:'ABMP("HIT")
S:ABM("XD")]"" ABM("XD")=$P($G(^ABMDTXST(DUZ(2),ABM("XD"),0)),U)
I $G(ABMY("DT"))="X",ABM("XD")<ABMY("DT",1)!(ABM("XD")>ABMY("DT",2)) Q
I $G(ABMY("DT"))="A",ABM("AD")<ABMY("DT",1)!(ABM("AD")>ABMY("DT",2)) Q
I $G(ABMY("DT"))="V",ABM("D")<ABMY("DT",1)!(ABM("D")>ABMY("DT",2)) Q
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-PT",$J,$E(ABM("L"),1,18)_U_ABM("S1")_U_$E(ABM("S2"),1,15)_U_$E($P(^DPT(ABM("P"),0),U),1,15)_U_ABM)=""
Q
;
STAT I '$D(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3"))) S ^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3"))=""
S $P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)=$P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)+1
S $P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)=$P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)+$P($G(^ABMDBILL(DUZ(2),ABM,2)),U)
;
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-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)=$P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)+ABM("PD")
S $P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)=$P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)+ABM("DEDCT")
S $P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)=$P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)+ABM("WO")
S $P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)=$P(^TMP("ABM-PT",$J,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)+ABM("OB")
Q
;
XIT K ABM,ABMY,ABMP
Q
ABMDRPT ; IHS/ASDST/DMJ - Bill Listing ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;
+3 ;
+4 KILL ABM,ABMY
SET ABM("PAY")=""
SET ABMP("TYP")=3
+5 SET ABM("PRIVACY")=1
SET ABM("COST")=""
SEL SET DIC="^AUPNPAT("
SET DIC(0)="QEAM"
DO ^DIC
IF X=""!$DATA">DATA(DTOUT)!$DATA">DATA(DUOUT)
GOTO XIT
IF +Y<1
GOTO SEL
SET ABM("PAT")=+Y
+1 WRITE !
KILL DIR
+2 SET DIR(0)="YO"
SET DIR("A")="Screen out BILLS that are COMPLETED"
+3 SET DIR("?")="Answer YES if those Bills that are in a Completed Status (unobligated balance equal to zero) are to be screened out (not included)."
+4 SET DIR("B")="N"
DO ^DIR
IF $DATA">DATA(DIRUT)!$DATA">DATA(DIROUT)
GOTO XIT
+5 SET ABMP("COMPL")=+Y
+6 SET ABM("RTYP")=1
SET ABM("RTYP","NM")="BRIEF LISTING (80 Width)"
DO ^ABMDRSEL
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
GOTO XIT
HD SET ABM("HD",0)="BILLING ACTIVITY of "_$PIECE(^DPT(ABM("PAT"),0),U)
+1 DO ^ABMDRHD
+2 SET ABMQ("RC")="COMPUTE^ABMDRPT"
SET ABMQ("RX")="POUT^ABMDRUTL"
SET ABMQ("NS")="ABM"
+3 IF ABM("RTYP")<3
SET ABMQ("RP")="PRINT^ABMDRPT"_ABM("RTYP")
+4 IF '$TEST
SET ABMQ("RP")="PRINT^ABMDRAL"_ABM("RTYP")
+5 ;S ABM("$J")=DUZ_"-"_$P($H,",",1)_"-"_$P($H,",",2)
+6 DO ^ABMDRDBQ
+7 QUIT
+8 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABM("SUBR")="ABM-PT"
KILL ^TMP("ABM-PT",$JOB),^TMP("ABM-PT",$JOB,"ST")
PAT SET ABM=""
FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"D",ABM("PAT"),ABM))
IF 'ABM
QUIT
DO DATA
+1 QUIT
+2 ;
DATA SET ABMP("HIT")=0
DO ^ABMDRCHK
IF 'ABMP("HIT")
QUIT
+1 IF ABM("XD")]""
SET ABM("XD")=$PIECE($GET(^ABMDTXST(DUZ(2),ABM("XD"),0)),U)
+2 IF $GET(ABMY("DT"))="X"
IF ABM("XD")<ABMY("DT",1)!(ABM("XD")>ABMY("DT",2))
QUIT
+3 IF $GET(ABMY("DT"))="A"
IF ABM("AD")<ABMY("DT",1)!(ABM("AD")>ABMY("DT",2))
QUIT
+4 IF $GET(ABMY("DT"))="V"
IF ABM("D")<ABMY("DT",1)!(ABM("D")>ABMY("DT",2))
QUIT
+5 SET ABM("S1")=$SELECT(ABMY("SORT")="C":ABM("C"),1:ABM("V"))
+6 SET ABM("S2")=$SELECT(ABM("RTYP")=3:0,1:$PIECE(^AUTNINS(ABM("I"),0),U))
+7 SET ABM("S3")=$SELECT(ABM("RTYP")=3:0,1:ABM)
+8 SET ABM("L")=$PIECE(^DIC(4,ABM("L"),0),U)
+9 IF ABM("RTYP")>2
GOTO STAT
+10 SET ^TMP("ABM-PT",$JOB,$EXTRACT(ABM("L"),1,18)_U_ABM("S1")_U_$EXTRACT(ABM("S2"),1,15)_U_$EXTRACT($PIECE(^DPT(ABM("P"),0),U),1,15)_U_ABM)=""
+11 QUIT
+12 ;
STAT IF '$DATA(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")))
SET ^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3"))=""
+1 SET $PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)=$PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U)+1
+2 SET $PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)=$PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,2)+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,2)),U)
+3 ;
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-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)=$PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,3)+ABM("PD")
+9 SET $PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)=$PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,4)+ABM("DEDCT")
+10 SET $PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)=$PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,5)+ABM("WO")
+11 SET $PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)=$PIECE(^TMP("ABM-PT",$JOB,"ST",ABM("L"),ABM("S1"),ABM("S2"),ABM("S3")),U,6)+ABM("OB")
+12 QUIT
+13 ;
XIT KILL ABM,ABMY,ABMP
+1 QUIT
