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

RCFMOBR1.m

Go to the documentation of this file. 
  1. RCFMOBR1 ;WASH-ISC@ALTOONA,PA/RWT-BILL RECONCILIATIONS LIST ;7/10/97  11:17 AM
  1.  ;;4.5;Accounts Receivable;**53,73,90,203,220**;Mar 20, 1995
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;      OBR Data Structure used by this routine
  1.  ; ^TMP("OBR",$J,SITE,"NOT IN AR")=NextRec^TotalItems^TotalFMSAmt
  1.  ; ^TMP("OBR",$J,SITE,"NOT IN FMS")=NextRec^TotalItems^TotalARAmt
  1.  ; ^TMP("OBR",$J,SITE,"DISCREPANCY")=NextRec^TotalItems^TotalFMSAmt^TotalARAmt
  1.  ; ^TMP("OBR",$J,"BN",BILLNUMBER)=[423.6 rec] <-- x-ref of FMS Bills
  1.  ; ^TMP("OBR",$J,"REPORT","1")="LINE 1"
  1.  ; ^TMP("OBR",$J","REPORT,"2")="LINE 2"
  1.  ; Modules:
  1.  ;    PROCFMS  -  loop through FMS bills (^PRCF(423.6)) updating
  1.  ;                global ^TMP("OBR",$J,"BN") while also checking
  1.  ;                for invalid AR bills
  1.  ;    PROCAR   -  loop through all Active AR Bills comparing amounts
  1.  ;                and looking for Detail bills not found in FMS
  1.  ;    SAVE     -  Saves the errors to tmp global ^TMP("OBR",site)
  1.  ;
  1.  ;
  1. PROCFMS(A0) N NODE,FUND,RSC,SRSC,ND,BN,SN,A1
  1.  S A1=0 F  S A1=$O(^PRCF(423.6,A0,1,A1)) Q:+A1=0  S ND=^(A1,0) D
  1.    .I $P(ND,U)="OBR" D  Q
  1.       ..; LIN Segment with OBR identifies FMS data
  1.       ..S ND=^PRCF(423.6,A0,1,A1,0)
  1.       ..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:"")
  1.       ..S BN=$P(ND,U,4) I $D(^TMP("OBR",$J,"BN",BN)) Q
  1.       ..S ^TMP("OBR",$J,"BN",BN)=A1,EM=""
  1.       ..S BN=$E($P(ND,U,4),1,3)_"-"_$E($P(ND,U,4),4,10)
  1.       ..S A2=$O(^PRCA(430,"B",BN,0))
  1.       ..I A2=""!('$D(^PRCA(430,+A2,0))) D  Q:A2=""
  1.           ...S AM1=+$P(ND,U,6)
  1.           ...S AM2=0,DB="UNKNOWN"
  1.           ...D SAVE(SN,BN,DB,AM1,AM2,"NOT IN AR")
  1.       ..S NODE=$G(^PRCA(430,+A2,11)) Q:NODE=""
  1.       ..I FUND'=$P(NODE,U,17) D SAVE(SN,BN,$P(NODE,U,17),FUND,0,"FUND MISMATCH")
  1.       ..I RSC'=$P(NODE,U,6) D SAVE(SN,BN,$P(NODE,U,6),RSC,0,"RSC MISMATCH")
  1.       ..I SRSC'=$P(NODE,U,7) D SAVE(SN,BN,$P(NODE,U,7),SRSC,0,"SUB RSC MISMATCH")
  1.  Q
  1. PROCAR(A0) ;
  1.  ; - Process all Active AR Bills
  1.  N A2,BN,AM1,AM2,AM3,DB,EM,ND,SN,FMSBN
  1.  S A2=0 F  S A2=$O(^PRCA(430,"AC",16,A2)) Q:+A2=0  D
  1.    .I $D(^PRCA(430,A2,0)),$P(^(0),U,18)'="01610A1",'$$ACCK^PRCAACC(A2) D
  1.      ..Q:$P(^PRCA(430,A2,0),"^",2)=29
  1.      ..I $P(^PRCA(430,A2,0),"^",2)=6,$E($P(^(0),"^",18),1,4)=5287,$$PTACCT^PRCAACC($P(^(0),U,18)) Q
  1.      ..I $P(^PRCA(430,A2,0),"^",2)=6,$P(^(0),"^",18)=5014 Q
  1.      ..S BN=$P(^PRCA(430,A2,0),U),SN=$P(BN,"-") D
  1.        ...S FMSBN=$P(BN,"-")_$P(BN,"-",2)
  1.        ...S AM2=$S($D(^PRCA(430,A2,7)):+^(7),1:0)
  1.        ...S DB=$E($$NAM^RCFN01(+$P(^PRCA(430,A2,0),U,9)),1,26)
  1.        ...I '$D(^TMP("OBR",$J,"BN",FMSBN)) D  Q
  1.          ....S AM1=0
  1.          ....D SAVE(SN,BN,DB,AM1,AM2,"NOT IN FMS")
  1.        ...I $D(^TMP("OBR",$J,"BN",FMSBN)) D
  1.          ....S ND=^PRCF(423.6,A0,1,^TMP("OBR",$J,"BN",FMSBN),0)
  1.          ....S AM1=+$P(ND,U,6)
  1.          ....I AM1'=AM2 D SAVE(SN,BN,DB,AM1,AM2,"DISCREPANCY")
  1.  Q
  1. SAVE(SN,BILL,DEBTOR,FMSAMT,ARAMT,ERR) N S0,S1,S2,S3,N,DIFF
  1.  S S0="",$P(S0," ",(19-$L(BILL)))=""
  1.  S S1="",$P(S1," ",(15-$L(BILL)))=""
  1.  S S2="",$P(S2," ",(30-$L(DEBTOR)))=""
  1.  I ERR="NOT IN AR" D  Q
  1.    .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0^0"
  1.    .S N=^TMP("OBR",$J,SN,ERR)
  1.    .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S0_$J(FMSAMT,10,2)
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,3)=$P(N,U,3)+FMSAMT
  1.  I ERR="NOT IN FMS" D  Q
  1.    .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0^0"
  1.    .S N=^TMP("OBR",$J,SN,ERR)
  1.    .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S1_DEBTOR_S2_$J(ARAMT,10,2)
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,3)=$P(N,U,3)+ARAMT
  1.  I ERR="DISCREPANCY" D  Q
  1.    .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0^0^0"
  1.    .S N=^TMP("OBR",$J,SN,ERR)
  1.    .S DIFF=$S(FMSAMT>ARAMT:$J(FMSAMT-ARAMT,0,2),1:"+"_$J(ARAMT-FMSAMT,0,2))
  1.    .S S3="",$P(S3," ",11-$L(DIFF))="",DIFF=S3_DIFF
  1.    .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S1_DEBTOR_S2_$J(FMSAMT,10,2)_"  "_$J(ARAMT,10,2)_"   "_DIFF
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,3)=$P(N,U,3)+FMSAMT
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,4)=$P(N,U,4)+ARAMT
  1.  I ERR="FUND MISMATCH" D  Q
  1.    .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0"
  1.    .S N=^TMP("OBR",$J,SN,ERR)
  1.    .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S2_DEBTOR_S2_FMSAMT
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
  1.  I ERR="RSC MISMATCH" D  Q
  1.    .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0"
  1.    .S N=^TMP("OBR",$J,SN,ERR)
  1.    .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S2_DEBTOR_S2_FMSAMT
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
  1.  I ERR="SUB RSC MISMATCH" D  Q
  1.    .I '$D(^TMP("OBR",$J,SN,ERR)) S ^(ERR)="1^0"
  1.    .S N=^TMP("OBR",$J,SN,ERR)
  1.    .S ^TMP("OBR",$J,SN,ERR,+N)=BILL_S2_DEBTOR_S2_FMSAMT
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U)=+N+1
  1.    .S $P(^TMP("OBR",$J,SN,ERR),U,2)=$P(N,U,2)+1
  1.  Q