- 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
