- ABMDRAGE ; IHS/ASDST/DMJ - A/R Aged Report ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;
- ;
- K ABM,ABMY,ABMQ
- S ABM(132)="",ABM("OVER-DUE")=3
- D ^ABMDRSEL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- HD S ABM("HD",0)="AGED ACCOUNTS RECEIVABLE SUMMARY" D ^ABMDRHD
- S ABMQ("RC")="COMPUTE^ABMDRAGE",ABMQ("RP")="PRINT^ABMDRAG1",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"
- ;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-AG" K ^TMP(ABM("SUBR"),$J)
- S ABMP("RTN")="ABMDRAGE" D LOOP^ABMDRUTL
- Q
- ;
- DATA Q:'$D(^ABMDBILL(DUZ(2),ABM,0)) Q:$P(^(0),U,4)="C"
- S ABMP("HIT")=0 D ^ABMDRCHK Q:'ABMP("HIT")
- S ABM("INS")=$P(^AUTNINS(ABM("I"),0),U)
- S X2=$P($G(^ABMDBILL(DUZ(2),ABM,1)),U,7) Q:X2="" S ABM("B")=$P(^ABMDBILL(DUZ(2),ABM,2),U),X2=$P(^ABMDTXST(DUZ(2),X2,0),U),X1=DT D ^%DTC S ABM("AG")=$S(X<31:3,X<61:4,X<91:5,X<121:6,1:7)
- S (ABM("J"),ABM("PD"))=0 F S ABM("J")=$O(^ABMDBILL(DUZ(2),ABM,3,ABM("J"))) Q:'ABM("J") D
- .S ABM("PD")=$P(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0),U,2)+ABM("PD")
- S X=ABM("INS"),ABM("BAL")=ABM("B")-ABM("PD"),ABM("CR")=0
- TL S:'$D(^TMP("ABM-AG",$J)) ^TMP("ABM-AG",$J)=0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0
- S $P(^TMP("ABM-AG",$J),U)=$P(^($J),U)+1,$P(^($J),U,2)=$P(^($J),U,2)+ABM("CR"),$P(^($J),U,8)=$P(^($J),U,8)+ABM("BAL")
- S $P(^TMP("ABM-AG",$J),U,ABM("AG"))=$P(^($J),U,ABM("AG"))+ABM("BAL"),$P(^($J),U,9)=$P(^($J),U,9)+ABM("BAL")-ABM("CR")
- S:'$D(^TMP("ABM-AG",$J,X)) ^TMP("ABM-AG",$J,X)=0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0
- S $P(^TMP("ABM-AG",$J,X),U)=$P(^(X),U)+1,$P(^(X),U,2)=$P(^(X),U,2)+ABM("CR"),$P(^(X),U,8)=$P(^(X),U,8)+ABM("BAL"),$P(^(X),U,ABM("AG"))=$P(^(X),U,ABM("AG"))+ABM("BAL"),$P(^(X),U,9)=$P(^(X),U,9)+ABM("BAL")-ABM("CR")
- Q
- ABMDRAGE ; IHS/ASDST/DMJ - A/R Aged Report ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;TMD;
- +3 ;
- +4 KILL ABM,ABMY,ABMQ
- +5 SET ABM(132)=""
- SET ABM("OVER-DUE")=3
- +6 DO ^ABMDRSEL
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- HD SET ABM("HD",0)="AGED ACCOUNTS RECEIVABLE SUMMARY"
- DO ^ABMDRHD
- +1 SET ABMQ("RC")="COMPUTE^ABMDRAGE"
- SET ABMQ("RP")="PRINT^ABMDRAG1"
- SET ABMQ("RX")="POUT^ABMDRUTL"
- SET ABMQ("NS")="ABM"
- +2 ;S ABM("$J")=DUZ_"-"_$P($H,",",1)_"-"_$P($H,",",2)
- +3 DO ^ABMDRDBQ
- +4 QUIT
- +5 ;
- COMPUTE ;EP - Entry Point for Setting up Data
- +1 SET ABM("SUBR")="ABM-AG"
- KILL ^TMP(ABM("SUBR"),$JOB)
- +2 SET ABMP("RTN")="ABMDRAGE"
- DO LOOP^ABMDRUTL
- +3 QUIT
- +4 ;
- DATA IF '$DATA(^ABMDBILL(DUZ(2),ABM,0))
- QUIT
- IF $PIECE(^(0),U,4)="C"
- QUIT
- +1 SET ABMP("HIT")=0
- DO ^ABMDRCHK
- IF 'ABMP("HIT")
- QUIT
- +2 SET ABM("INS")=$PIECE(^AUTNINS(ABM("I"),0),U)
- +3 SET X2=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,1)),U,7)
- IF X2=""
- QUIT
- SET ABM("B")=$PIECE(^ABMDBILL(DUZ(2),ABM,2),U)
- SET X2=$PIECE(^ABMDTXST(DUZ(2),X2,0),U)
- SET X1=DT
- DO ^%DTC
- SET ABM("AG")=$SELECT(X<31:3,X<61:4,X<91:5,X<121:6,1:7)
- +4 SET (ABM("J"),ABM("PD"))=0
- FOR
- SET ABM("J")=$ORDER(^ABMDBILL(DUZ(2),ABM,3,ABM("J")))
- IF 'ABM("J")
- QUIT
- Begin DoDot:1
- +5 SET ABM("PD")=$PIECE(^ABMDBILL(DUZ(2),ABM,3,ABM("J"),0),U,2)+ABM("PD")
- End DoDot:1
- +6 SET X=ABM("INS")
- SET ABM("BAL")=ABM("B")-ABM("PD")
- SET ABM("CR")=0
- TL IF '$DATA(^TMP("ABM-AG",$JOB))
- SET ^TMP("ABM-AG",$JOB)=0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0
- +1 SET $PIECE(^TMP("ABM-AG",$JOB),U)=$PIECE(^($JOB),U)+1
- SET $PIECE(^($JOB),U,2)=$PIECE(^($JOB),U,2)+ABM("CR")
- SET $PIECE(^($JOB),U,8)=$PIECE(^($JOB),U,8)+ABM("BAL")
- +2 SET $PIECE(^TMP("ABM-AG",$JOB),U,ABM("AG"))=$PIECE(^($JOB),U,ABM("AG"))+ABM("BAL")
- SET $PIECE(^($JOB),U,9)=$PIECE(^($JOB),U,9)+ABM("BAL")-ABM("CR")
- +3 IF '$DATA(^TMP("ABM-AG",$JOB,X))
- SET ^TMP("ABM-AG",$JOB,X)=0_U_0_U_0_U_0_U_0_U_0_U_0_U_0_U_0
- +4 SET $PIECE(^TMP("ABM-AG",$JOB,X),U)=$PIECE(^(X),U)+1
- SET $PIECE(^(X),U,2)=$PIECE(^(X),U,2)+ABM("CR")
- SET $PIECE(^(X),U,8)=$PIECE(^(X),U,8)+ABM("BAL")
- SET $PIECE(^(X),U,ABM("AG"))=$PIECE(^(X),U,ABM("AG"))+ABM("BAL")
- SET $PIECE(^(X),U,9)=$PIECE(^(X),U,9)+ABM("BAL")-ABM("CR")
- +5 QUIT
