Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAREPC

PRCAREPC.m

Go to the documentation of this file.
  1. PRCAREPC ;SF-ISC/NYB-CATEGORY LIST-BILLS ;8/26/93 8:43 AM
  1. V ;;4.5;Accounts Receivable;**72,94,63**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. EN N BN,BN0,BN7,CBAL,DBP,DBP1,DEB,DEBT,DP1,FL,III
  1. N NCT,NCT2,NDE,PBAL,RCDOJ,SCT,SCT2,STAB
  1. N STOT,STOT2,TFLG,TOT,TOT2
  1. I CAT="ALL" S CNO=0 F S CNO=$O(^PRCA(430.2,"AC",CNO)) Q:CNO="" D
  1. .S CAT=0 S CAT=$O(^PRCA(430.2,"AC",CNO,CAT)) Q:CAT="" D
  1. ..S ^TMP($J,"PRCAT",CAT)=""
  1. ..Q
  1. .Q
  1. I ST="ALL" S ST=0 F S ST=($O(^PRCA(430.3,"AC",ST))) Q:ST="" D
  1. .Q:ST<100!(ST=107)
  1. .S ^TMP($J,"PRCAST",$O(^PRCA(430.3,"AC",ST,0)))=""
  1. .Q
  1. S (CAT,TFLG)=0 F S CAT=$O(^TMP($J,"PRCAT",CAT)) Q:CAT=""!($G(OT)="^") D
  1. .S ST=0 F S ST=$O(^TMP($J,"PRCAST",ST)) Q:ST=""!($G(OT)="^") D
  1. ..S ^TMP($J,"PRCASC",ST,CAT)=1
  1. ..Q
  1. .Q
  1. S ST=0 F S ST=$O(^TMP($J,"PRCASC",ST)) Q:ST="" D
  1. .S (NCT,PRCAE,TOT,TOT2)=0 F S PRCAE=$O(^PRCA(430,"AC",ST,PRCAE)),X="" Q:'PRCAE D
  1. ..N DEB
  1. ..Q:'$O(^TMP($J,"PRCASC",0))
  1. ..S BN0=$G(^PRCA(430,PRCAE,0))
  1. ..S BN=$P($G(BN0),"^")
  1. ..S RCDOJ=$$REFST^RCRCUTL(PRCAE)
  1. ..I RCDOJ S BN=BN_"r"
  1. ..S CT4=$P($G(BN0),"^",2)
  1. ..S CAT=+$O(^TMP($J,"PRCASC",ST,(CT4-1)))
  1. ..I +$G(CAT)'>0 Q
  1. ..I $G(CT4)'=CAT Q
  1. ..S DEBT=$P($G(BN0),"^",9)
  1. ..I $G(DEBT) D
  1. ...S DEB=$P($G(^RCD(340,DEBT,0)),"^") Q:'DEB
  1. ...S DEB="^"_$P(DEB,";",2)_+DEB_",0)"
  1. ...S DEB=$G(@DEB),DEB=$P(DEB,"^")
  1. ...Q
  1. ..S DBP=$P($G(BN0),"^",10)
  1. ..I DT1'="",DBP<DT1 Q
  1. ..I DT2'="",DBP>DT2 Q
  1. ..I '$G(DBP) S DBP="**NONE**"
  1. ..S ST2=$G(^PRCA(430.3,ST,0))
  1. ..S STAB=$P($G(ST2),"^",2),ST2=$P($G(ST2),"^")
  1. ..S CAT2=$P($G(^PRCA(430.2,CT4,0)),"^")
  1. ..S BN7=$G(^PRCA(430,PRCAE,7))
  1. ..S PBAL=+$P($G(BN7),"^")
  1. ..S CBAL=0 F X=1:1:5 S CBAL=CBAL+$P($G(BN7),"^",X)
  1. ..S ^TMP($J,"PRCACS",CAT2,STAB,DBP,BN)=BN_"^"_$G(DEB)_"^"_PBAL_"^"_CBAL
  1. ..Q
  1. .Q
  1. K ^TMP($J,"PRCAT"),^TMP($J,"PRCASC"),^TMP($J,"PRCAST")
  1. WRITE ;Write out report.
  1. I '$D(^TMP($J,"PRCACS")) D HDR1 I $E(IOST)'="C" W @IOF Q
  1. S (FL,NCT,SCT,STOT,STOT2,TOT,TOT2)=0
  1. S CAT="" F S CAT=$O(^TMP($J,"PRCACS",CAT)) G:CAT=""!($G(OT)="^") ENQ D
  1. .I 'FL D HDR
  1. .I FL,$E(IOST)="C" D TOP Q:$G(OT)="^" D HDR S FL=0
  1. .I FL,$E(IOST)="P" W @IOF D HDR S FL=0
  1. .S STAB="" F S STAB=$O(^TMP($J,"PRCACS",CAT,STAB)) Q:STAB=""!($G(OT)="^") D
  1. ..I FL,$E(IOST)="C" D TOP Q:$G(OT)="^" D HDR
  1. ..I FL,$E(IOST)="P" W @IOF D HDR
  1. ..S DBP=0 F S DBP=$O(^TMP($J,"PRCACS",CAT,STAB,DBP)) Q:DBP=""!($G(OT)="^") S BN=0 F S BN=$O(^TMP($J,"PRCACS",CAT,STAB,DBP,BN)) Q:BN=""!($G(OT)="^") D
  1. ...S NDE=$G(^TMP($J,"PRCACS",CAT,STAB,DBP,BN))
  1. ...S Y=DBP D DD^%DT S DBP1=Y
  1. ...S DEB=$P($G(NDE),"^",2)
  1. ...S PBAL=$P($G(NDE),"^",3),CBAL=$P($G(NDE),"^",4)
  1. ...S STOT=STOT+PBAL,SCT=SCT+1
  1. ...S STOT2=STOT2+CBAL
  1. ...W !,BN,?14,$E(DEB,1,15),?32,DBP1,?46,STAB,?51,$J(PBAL,9,2),?65,$J(CBAL,9,2)
  1. ...I $E(IOST)="C",$Y+5>IOSL D TOP Q:$G(OT)="^" D HDR
  1. ...I $E(IOST)="P",$Y+5>IOSL W @IOF D HDR
  1. ...S FL=1
  1. ...Q
  1. ..D SUB
  1. ..Q
  1. .D TOT
  1. .W !!,"( r - Bill is Currently Referred )",!
  1. .Q
  1. ENQ K ^TMP($J),DIC,DIC(0)
  1. Q
  1. TOP ;Press return to continue prompt.
  1. N DTOUT,DUOUT,DIRUT,DIR,DIROUT,Y
  1. Q:$G(OT)="^"
  1. S DIR(0)="E" D ^DIR I +Y=0 S OT="^"
  1. TOPQ Q
  1. HDR ;Header of the report.
  1. I $E(IOST)="C" W @IOF
  1. W "CATEGORY LISTING FOR BILLS REPORT",?45," ",SDT," Page: "_PAGE
  1. W !,"Sort Criteria for Date Prepared: "_SC1_" to "_SC2
  1. W !,?32,"Date",?52,"Princpal",?68,"Current"
  1. W !,"Bill No.",?14,"Debtor",?32,"Preprd",?43,"Status"
  1. W ?52,"Balance",?68,"Balance"
  1. S X="",$P(X,"-",IOM-1)="" W !,X,!
  1. W !,?7,"CATEGORY: "_$G(CAT),!!
  1. S PAGE=PAGE+1
  1. HDRQ Q
  1. HDR1 ;Header if there is nothing to print.
  1. I $E(IOST)="C" W @IOF
  1. W "CATEGORY LISTING FOR BILLS REPORT",?45," ",SDT," Page: "_PAGE
  1. W !,"Sort Criteria for Date Prepared: "_SC1_" to "_SC2
  1. W !,?32,"Date",?52,"Princpal",?68,"Current"
  1. W !,"Bill No.",?14,"Debtor",?32,"Preprd",?43,"Status"
  1. W ?52,"Balance",?68,"Balance"
  1. S X="",$P(X,"-",IOM-1)="" W !,X,!
  1. W !!,"****NO RECORDS TO PRINT****",!!
  1. HDR1Q Q
  1. SUB ;Calculates the subtotals
  1. D SUB1 Q:$G(OT)="^"
  1. S (STOT,STOT2,SCT)=0
  1. SUBQ Q
  1. SUB1 I $G(Y)="^" S OT="^"
  1. I $G(SCT)>0 W !?50,"----------",?64,"----------",!?41,"SUBTOTAL:"
  1. I W ?50,$J(STOT,10,2),?64,$J(STOT2,10,2),!?41,"SUBCOUNT:"
  1. I W ?50,$J(SCT,10),?64,$J(SCT,10)
  1. S NCT=NCT+SCT,TOT=TOT+STOT,TOT2=TOT2+STOT2
  1. SUB1Q Q
  1. TOT ;Calculates the totals.
  1. W !?50,"----------",?64,"----------"
  1. W !?44,"TOTAL:",?50,$J(TOT,10,2),?64,$J(TOT2,10,2)
  1. I $G(NCT)>0 W !?44,"COUNT:",?50,$J(NCT,10),?64,$J(NCT,10)
  1. S (NCT,TOT,TOT2)=0
  1. S TFLG=1
  1. TOTQ Q