source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMOBR1.m@ 1716

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1RCFMOBR1 ;WASH-ISC@ALTOONA,PA/RWT-BILL RECONCILIATIONS LIST ;7/10/97 11:17 AM
2 ;;4.5;Accounts Receivable;**53,73,90,203,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; OBR Data Structure used by this routine
5 ; ^TMP("OBR",$J,SITE,"NOT IN AR")=NextRec^TotalItems^TotalFMSAmt
6 ; ^TMP("OBR",$J,SITE,"NOT IN FMS")=NextRec^TotalItems^TotalARAmt
7 ; ^TMP("OBR",$J,SITE,"DISCREPANCY")=NextRec^TotalItems^TotalFMSAmt^TotalARAmt
8 ; ^TMP("OBR",$J,"BN",BILLNUMBER)=[423.6 rec] <-- x-ref of FMS Bills
9 ; ^TMP("OBR",$J,"REPORT","1")="LINE 1"
10 ; ^TMP("OBR",$J","REPORT,"2")="LINE 2"
11 ; Modules:
12 ; PROCFMS - loop through FMS bills (^PRCF(423.6)) updating
13 ; global ^TMP("OBR",$J,"BN") while also checking
14 ; for invalid AR bills
15 ; PROCAR - loop through all Active AR Bills comparing amounts
16 ; and looking for Detail bills not found in FMS
17 ; SAVE - Saves the errors to tmp global ^TMP("OBR",site)
18 ;
19 ;
20PROCFMS(A0) N NODE,FUND,RSC,SRSC,ND,BN,SN,A1
21 S A1=0 F S A1=$O(^PRCF(423.6,A0,1,A1)) Q:+A1=0 S ND=^(A1,0) D
22 .I $P(ND,U)="OBR" D Q
23 ..; LIN Segment with OBR identifies FMS data
24 ..S ND=^PRCF(423.6,A0,1,A1,0)
25 ..S SN=$P(ND,U,2),FUND=$S($P(ND,U,7)'="~":$P(ND,U,7),1:""),RSC=$S($P(ND,U,8)'="~":$P(ND,U,8),1:""),SRSC=$S($P(ND,U,9)'="~":$P(ND,U,9),1:"")
26 ..S BN=$P(ND,U,4) I $D(^TMP("OBR",$J,"BN",BN)) Q
27 ..S ^TMP("OBR",$J,"BN",BN)=A1,EM=""
28 ..S BN=$E($P(ND,U,4),1,3)_"-"_$E($P(ND,U,4),4,10)
29 ..S A2=$O(^PRCA(430,"B",BN,0))
30 ..I A2=""!('$D(^PRCA(430,+A2,0))) D Q:A2=""
31 ...S AM1=+$P(ND,U,6)
32 ...S AM2=0,DB="UNKNOWN"
33 ...D SAVE(SN,BN,DB,AM1,AM2,"NOT IN AR")
34 ..S NODE=$G(^PRCA(430,+A2,11)) Q:NODE=""
35 ..I FUND'=$P(NODE,U,17) D SAVE(SN,BN,$P(NODE,U,17),FUND,0,"FUND MISMATCH")
36 ..I RSC'=$P(NODE,U,6) D SAVE(SN,BN,$P(NODE,U,6),RSC,0,"RSC MISMATCH")
37 ..I SRSC'=$P(NODE,U,7) D SAVE(SN,BN,$P(NODE,U,7),SRSC,0,"SUB RSC MISMATCH")
38 Q
39PROCAR(A0) ;
40 ; - Process all Active AR Bills
41 N A2,BN,AM1,AM2,AM3,DB,EM,ND,SN,FMSBN
42 S A2=0 F S A2=$O(^PRCA(430,"AC",16,A2)) Q:+A2=0 D
43 .I $D(^PRCA(430,A2,0)),$P(^(0),U,18)'="01610A1",'$$ACCK^PRCAACC(A2) D
44 ..Q:$P(^PRCA(430,A2,0),"^",2)=29
45 ..I $P(^PRCA(430,A2,0),"^",2)=6,$E($P(^(0),"^",18),1,4)=5287,$$PTACCT^PRCAACC($P(^(0),U,18)) Q
46 ..I $P(^PRCA(430,A2,0),"^",2)=6,$P(^(0),"^",18)=5014 Q
47 ..S BN=$P(^PRCA(430,A2,0),U),SN=$P(BN,"-") D
48 ...S FMSBN=$P(BN,"-")_$P(BN,"-",2)
49 ...S AM2=$S($D(^PRCA(430,A2,7)):+^(7),1:0)
50 ...S DB=$E($$NAM^RCFN01(+$P(^PRCA(430,A2,0),U,9)),1,26)
51 ...I '$D(^TMP("OBR",$J,"BN",FMSBN)) D Q
52 ....S AM1=0
53 ....D SAVE(SN,BN,DB,AM1,AM2,"NOT IN FMS")
54 ...I $D(^TMP("OBR",$J,"BN",FMSBN)) D
55 ....S ND=^PRCF(423.6,A0,1,^TMP("OBR",$J,"BN",FMSBN),0)
56 ....S AM1=+$P(ND,U,6)
57 ....I AM1'=AM2 D SAVE(SN,BN,DB,AM1,AM2,"DISCREPANCY")
58 Q
59SAVE(SN,BILL,DEBTOR,FMSAMT,ARAMT,ERR) N S0,S1,S2,S3,N,DIFF
60 S S0="",$P(S0," ",(19-$L(BILL)))=""
61 S S1="",$P(S1," ",(15-$L(BILL)))=""
62 S S2="",$P(S2," ",(30-$L(DEBTOR)))=""
63 I ERR="NOT IN AR" D Q
64 .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0^0"
65 .S N=^TMP("OBR",$J,SN,ERR)
66 .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S0_$J(FMSAMT,10,2)
67 .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
68 .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
69 .S $P(^TMP("OBR",$J,SN,ERR),U,3)=$P(N,U,3)+FMSAMT
70 I ERR="NOT IN FMS" D Q
71 .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0^0"
72 .S N=^TMP("OBR",$J,SN,ERR)
73 .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S1_DEBTOR_S2_$J(ARAMT,10,2)
74 .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
75 .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
76 .S $P(^TMP("OBR",$J,SN,ERR),U,3)=$P(N,U,3)+ARAMT
77 I ERR="DISCREPANCY" D Q
78 .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0^0^0"
79 .S N=^TMP("OBR",$J,SN,ERR)
80 .S DIFF=$S(FMSAMT>ARAMT:$J(FMSAMT-ARAMT,0,2),1:"+"_$J(ARAMT-FMSAMT,0,2))
81 .S S3="",$P(S3," ",11-$L(DIFF))="",DIFF=S3_DIFF
82 .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S1_DEBTOR_S2_$J(FMSAMT,10,2)_" "_$J(ARAMT,10,2)_" "_DIFF
83 .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
84 .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
85 .S $P(^TMP("OBR",$J,SN,ERR),U,3)=$P(N,U,3)+FMSAMT
86 .S $P(^TMP("OBR",$J,SN,ERR),U,4)=$P(N,U,4)+ARAMT
87 I ERR="FUND MISMATCH" D Q
88 .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0"
89 .S N=^TMP("OBR",$J,SN,ERR)
90 .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S2_DEBTOR_S2_FMSAMT
91 .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
92 .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
93 I ERR="RSC MISMATCH" D Q
94 .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0"
95 .S N=^TMP("OBR",$J,SN,ERR)
96 .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S2_DEBTOR_S2_FMSAMT
97 .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
98 .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
99 I ERR="SUB RSC MISMATCH" D Q
100 .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0"
101 .S N=^TMP("OBR",$J,SN,ERR)
102 .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S2_DEBTOR_S2_FMSAMT
103 .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
104 .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
105 Q
Note: See TracBrowser for help on using the repository browser.