source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAREPC.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1PRCAREPC ;SF-ISC/NYB-CATEGORY LIST-BILLS ;8/26/93 8:43 AM
2V ;;4.5;Accounts Receivable;**72,94,63**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN N BN,BN0,BN7,CBAL,DBP,DBP1,DEB,DEBT,DP1,FL,III
5 N NCT,NCT2,NDE,PBAL,RCDOJ,SCT,SCT2,STAB
6 N STOT,STOT2,TFLG,TOT,TOT2
7 I CAT="ALL" S CNO=0 F S CNO=$O(^PRCA(430.2,"AC",CNO)) Q:CNO="" D
8 .S CAT=0 S CAT=$O(^PRCA(430.2,"AC",CNO,CAT)) Q:CAT="" D
9 ..S ^TMP($J,"PRCAT",CAT)=""
10 ..Q
11 .Q
12 I ST="ALL" S ST=0 F S ST=($O(^PRCA(430.3,"AC",ST))) Q:ST="" D
13 .Q:ST<100!(ST=107)
14 .S ^TMP($J,"PRCAST",$O(^PRCA(430.3,"AC",ST,0)))=""
15 .Q
16 S (CAT,TFLG)=0 F S CAT=$O(^TMP($J,"PRCAT",CAT)) Q:CAT=""!($G(OT)="^") D
17 .S ST=0 F S ST=$O(^TMP($J,"PRCAST",ST)) Q:ST=""!($G(OT)="^") D
18 ..S ^TMP($J,"PRCASC",ST,CAT)=1
19 ..Q
20 .Q
21 S ST=0 F S ST=$O(^TMP($J,"PRCASC",ST)) Q:ST="" D
22 .S (NCT,PRCAE,TOT,TOT2)=0 F S PRCAE=$O(^PRCA(430,"AC",ST,PRCAE)),X="" Q:'PRCAE D
23 ..N DEB
24 ..Q:'$O(^TMP($J,"PRCASC",0))
25 ..S BN0=$G(^PRCA(430,PRCAE,0))
26 ..S BN=$P($G(BN0),"^")
27 ..S RCDOJ=$$REFST^RCRCUTL(PRCAE)
28 ..I RCDOJ S BN=BN_"r"
29 ..S CT4=$P($G(BN0),"^",2)
30 ..S CAT=+$O(^TMP($J,"PRCASC",ST,(CT4-1)))
31 ..I +$G(CAT)'>0 Q
32 ..I $G(CT4)'=CAT Q
33 ..S DEBT=$P($G(BN0),"^",9)
34 ..I $G(DEBT) D
35 ...S DEB=$P($G(^RCD(340,DEBT,0)),"^") Q:'DEB
36 ...S DEB="^"_$P(DEB,";",2)_+DEB_",0)"
37 ...S DEB=$G(@DEB),DEB=$P(DEB,"^")
38 ...Q
39 ..S DBP=$P($G(BN0),"^",10)
40 ..I DT1'="",DBP<DT1 Q
41 ..I DT2'="",DBP>DT2 Q
42 ..I '$G(DBP) S DBP="**NONE**"
43 ..S ST2=$G(^PRCA(430.3,ST,0))
44 ..S STAB=$P($G(ST2),"^",2),ST2=$P($G(ST2),"^")
45 ..S CAT2=$P($G(^PRCA(430.2,CT4,0)),"^")
46 ..S BN7=$G(^PRCA(430,PRCAE,7))
47 ..S PBAL=+$P($G(BN7),"^")
48 ..S CBAL=0 F X=1:1:5 S CBAL=CBAL+$P($G(BN7),"^",X)
49 ..S ^TMP($J,"PRCACS",CAT2,STAB,DBP,BN)=BN_"^"_$G(DEB)_"^"_PBAL_"^"_CBAL
50 ..Q
51 .Q
52 K ^TMP($J,"PRCAT"),^TMP($J,"PRCASC"),^TMP($J,"PRCAST")
53WRITE ;Write out report.
54 I '$D(^TMP($J,"PRCACS")) D HDR1 I $E(IOST)'="C" W @IOF Q
55 S (FL,NCT,SCT,STOT,STOT2,TOT,TOT2)=0
56 S CAT="" F S CAT=$O(^TMP($J,"PRCACS",CAT)) G:CAT=""!($G(OT)="^") ENQ D
57 .I 'FL D HDR
58 .I FL,$E(IOST)="C" D TOP Q:$G(OT)="^" D HDR S FL=0
59 .I FL,$E(IOST)="P" W @IOF D HDR S FL=0
60 .S STAB="" F S STAB=$O(^TMP($J,"PRCACS",CAT,STAB)) Q:STAB=""!($G(OT)="^") D
61 ..I FL,$E(IOST)="C" D TOP Q:$G(OT)="^" D HDR
62 ..I FL,$E(IOST)="P" W @IOF D HDR
63 ..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
64 ...S NDE=$G(^TMP($J,"PRCACS",CAT,STAB,DBP,BN))
65 ...S Y=DBP D DD^%DT S DBP1=Y
66 ...S DEB=$P($G(NDE),"^",2)
67 ...S PBAL=$P($G(NDE),"^",3),CBAL=$P($G(NDE),"^",4)
68 ...S STOT=STOT+PBAL,SCT=SCT+1
69 ...S STOT2=STOT2+CBAL
70 ...W !,BN,?14,$E(DEB,1,15),?32,DBP1,?46,STAB,?51,$J(PBAL,9,2),?65,$J(CBAL,9,2)
71 ...I $E(IOST)="C",$Y+5>IOSL D TOP Q:$G(OT)="^" D HDR
72 ...I $E(IOST)="P",$Y+5>IOSL W @IOF D HDR
73 ...S FL=1
74 ...Q
75 ..D SUB
76 ..Q
77 .D TOT
78 .W !!,"( r - Bill is Currently Referred )",!
79 .Q
80ENQ K ^TMP($J),DIC,DIC(0)
81 Q
82TOP ;Press return to continue prompt.
83 N DTOUT,DUOUT,DIRUT,DIR,DIROUT,Y
84 Q:$G(OT)="^"
85 S DIR(0)="E" D ^DIR I +Y=0 S OT="^"
86TOPQ Q
87HDR ;Header of the report.
88 I $E(IOST)="C" W @IOF
89 W "CATEGORY LISTING FOR BILLS REPORT",?45," ",SDT," Page: "_PAGE
90 W !,"Sort Criteria for Date Prepared: "_SC1_" to "_SC2
91 W !,?32,"Date",?52,"Princpal",?68,"Current"
92 W !,"Bill No.",?14,"Debtor",?32,"Preprd",?43,"Status"
93 W ?52,"Balance",?68,"Balance"
94 S X="",$P(X,"-",IOM-1)="" W !,X,!
95 W !,?7,"CATEGORY: "_$G(CAT),!!
96 S PAGE=PAGE+1
97HDRQ Q
98HDR1 ;Header if there is nothing to print.
99 I $E(IOST)="C" W @IOF
100 W "CATEGORY LISTING FOR BILLS REPORT",?45," ",SDT," Page: "_PAGE
101 W !,"Sort Criteria for Date Prepared: "_SC1_" to "_SC2
102 W !,?32,"Date",?52,"Princpal",?68,"Current"
103 W !,"Bill No.",?14,"Debtor",?32,"Preprd",?43,"Status"
104 W ?52,"Balance",?68,"Balance"
105 S X="",$P(X,"-",IOM-1)="" W !,X,!
106 W !!,"****NO RECORDS TO PRINT****",!!
107HDR1Q Q
108SUB ;Calculates the subtotals
109 D SUB1 Q:$G(OT)="^"
110 S (STOT,STOT2,SCT)=0
111SUBQ Q
112SUB1 I $G(Y)="^" S OT="^"
113 I $G(SCT)>0 W !?50,"----------",?64,"----------",!?41,"SUBTOTAL:"
114 I W ?50,$J(STOT,10,2),?64,$J(STOT2,10,2),!?41,"SUBCOUNT:"
115 I W ?50,$J(SCT,10),?64,$J(SCT,10)
116 S NCT=NCT+SCT,TOT=TOT+STOT,TOT2=TOT2+STOT2
117SUB1Q Q
118TOT ;Calculates the totals.
119 W !?50,"----------",?64,"----------"
120 W !?44,"TOTAL:",?50,$J(TOT,10,2),?64,$J(TOT2,10,2)
121 I $G(NCT)>0 W !?44,"COUNT:",?50,$J(NCT,10),?64,$J(NCT,10)
122 S (NCT,TOT,TOT2)=0
123 S TFLG=1
124TOTQ Q
Note: See TracBrowser for help on using the repository browser.