| 1 | RCFMOBR ;WASH-ISC@ALTOONA,PA/RWT-BILL RECONCILIATIONS LIST ;11/20/96 2:30 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**2,20,40,53**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;Creates report from OBR data in file 423.6
|
|---|
| 5 | ;
|
|---|
| 6 | ; OBR Data Structure used by this routine
|
|---|
| 7 | ; ^TMP("OBR",$J,SITE,"NOT IN AR")=NextRec^TotalItems^TotalFMSAmt
|
|---|
| 8 | ; ^TMP("OBR",$J,SITE,"NOT IN FMS")=NextRec^TotalItems^TotalARAmt
|
|---|
| 9 | ; ^TMP("OBR",$J,SITE,"DISCREPANCY")=NextRec^TotalItems^TotalFMSAmt^TotalARAmt
|
|---|
| 10 | ; ^TMP("OBR",$J,"BN",BILLNUMBER)=[423.6 rec] <-- x-ref of FMS Bills
|
|---|
| 11 | ; ^TMP("OBR",$J,"REPORT","1")="LINE 1"
|
|---|
| 12 | ; ^TMP("OBR",$J","REPORT,"2")="LINE 2"
|
|---|
| 13 | ;
|
|---|
| 14 | ; Descriptions of modules:
|
|---|
| 15 | ; PROCFMS - loop through FMS bills (^PRCF(423.6)) updating
|
|---|
| 16 | ; global ^TMP("OBR",$J,"BN") while also checking
|
|---|
| 17 | ; for invalid AR bills
|
|---|
| 18 | ; PROCAR - loop through all Active AR Bills comparing amounts
|
|---|
| 19 | ; and looking for Detail bills not found in FMS
|
|---|
| 20 | ; BUILDRPT - Prepares report in global ^TMP("OBR",$J,"REPORT")
|
|---|
| 21 | ;
|
|---|
| 22 | N X,Y,OBR,A0,ERR
|
|---|
| 23 | K ^TMP("OBR",$J)
|
|---|
| 24 | ;
|
|---|
| 25 | I $G(PRCADA) D PROCESS(PRCADA) G Q1
|
|---|
| 26 | S OBR="OBR-",ERR=-1
|
|---|
| 27 | F S OBR=$O(^PRCF(423.6,"B",OBR)) Q:OBR=""!(OBR'["OBR-") D
|
|---|
| 28 | .I $O(^PRCF(423.6,"B",OBR))'["OBR-" D Q
|
|---|
| 29 | ..S A0=$O(^PRCF(423.6,"B",OBR,0))
|
|---|
| 30 | ..S ERR=0 D PROCESS(A0)
|
|---|
| 31 | I ERR D PROCESS(ERR)
|
|---|
| 32 | Q1 K ^TMP("OBR",$J)
|
|---|
| 33 | Q
|
|---|
| 34 | PROCESS(A0) N X,X1,X2,Y,SN,PARENT,XMTEXT,XMSUB,XMSENDER,XMDUZ,ERR,DATE,FMSDATE
|
|---|
| 35 | S ERR=0 D
|
|---|
| 36 | .I '$D(^PRCF(423.6,A0,0)) S ERR=-1 Q
|
|---|
| 37 | .I $E(^PRCF(423.6,A0,0),1,3)'["OBR" S ERR=-1 Q
|
|---|
| 38 | .S X=$P(^PRCF(423.6,A0,0),"-",2)
|
|---|
| 39 | .S X=$E(X,5,6)_"-"_$E(X,7,8)_"-"_$E(X,1,4) D ^%DT ;Y is defined
|
|---|
| 40 | .S PARENT=$P($P(^PRCF(423.6,A0,0),"-",5),U)
|
|---|
| 41 | .;
|
|---|
| 42 | .D PROCFMS^RCFMOBR1(A0)
|
|---|
| 43 | .D PROCAR^RCFMOBR1(A0)
|
|---|
| 44 | .D BUILDRPT^RCFMOBR2(PARENT)
|
|---|
| 45 | ;
|
|---|
| 46 | I '$D(PARENT) S PARENT=$$SITE^RCMSITE
|
|---|
| 47 | S PARENT=$P(^DIC(4,+$O(^DIC(4,"D",PARENT,0)),0),U)
|
|---|
| 48 | ;
|
|---|
| 49 | I '$D(Y) S Y=DT ;Y may be defined from %DT call above
|
|---|
| 50 | S X1=Y,X2=($E(Y,6,7)+1)*-1 D C^%DTC,YX^%DTC
|
|---|
| 51 | S FMSDATE=$P(Y,"@"),FMSDATE=$E(FMSDATE,1,4)_$E(FMSDATE,9,12)
|
|---|
| 52 | D NOW^%DTC S DATE=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
|
|---|
| 53 | ; - Transmits report via e-mail to FMS mail group
|
|---|
| 54 | S XMSUB="FMS "_FMSDATE_" RECONCILIATION ("_DATE_") "
|
|---|
| 55 | S XMSUB=XMSUB_PARENT
|
|---|
| 56 | I ERR D
|
|---|
| 57 | .S ^TMP("OBR",$J,"REPORT",1)="Date of Report: "_DATE
|
|---|
| 58 | .S ^TMP("OBR",$J,"REPORT",2)="NOTE: This report compares your current A/R records with data received from"
|
|---|
| 59 | .S ^TMP("OBR",$J,"REPORT",3)=" FMS on the last day of the previous accounting period."
|
|---|
| 60 | .S ^TMP("OBR",$J,"REPORT",4)=""
|
|---|
| 61 | .S ^TMP("OBR",$J,"REPORT",5)="No FMS data exists to reconcile!"
|
|---|
| 62 | S XMTEXT="^TMP(""OBR"",$J,""REPORT"","
|
|---|
| 63 | S XMDUZ="Accounts Receivable Package",XMY("G.FMS")="",XMY(DUZ)="" D ^XMD
|
|---|
| 64 | Q
|
|---|
| 65 | EN2 ;Entry point from Regenerate Prior Month OBRs option
|
|---|
| 66 | N DIR,PRCADA,Y
|
|---|
| 67 | W !!,"This option will transmit the OBR report(s) to you and members"
|
|---|
| 68 | W !,"of the G.FMS mail group."
|
|---|
| 69 | W !!,"NOTE: Depending on the number of active AR bills in your system,"
|
|---|
| 70 | W !," this may take awhile to run.",!
|
|---|
| 71 | S DIR(0)="YO",DIR("A")="Are you sure you want to do this",DIR("B")="NO"
|
|---|
| 72 | D ^DIR Q:Y'=1 S ZTRTN="EN^RCFMOBR",ZTDESC="Prior Month OBRs"
|
|---|
| 73 | S ZTIO="" D ^%ZTLOAD Q
|
|---|
| 74 | ;
|
|---|
| 75 | EN3 ;Deletes OBRs over 60 days old
|
|---|
| 76 | N A0,A1,A2,DA,DIK,X,X1,X2
|
|---|
| 77 | S A0="OBR-" F S A0=$O(^PRCF(423.6,"B",A0)) Q:A0=""!(A0'["OBR-") S A1=2_$E($P(A0,"-",2),3,8),A2=0 F S A2=$O(^PRCF(423.6,"B",A0,A2)) Q:+A2=0 D
|
|---|
| 78 | .S X1=DT,X2=A1 D ^%DTC I X>60 S DIK="^PRCF(423.6,",DA=A2 D ^DIK
|
|---|
| 79 | Q
|
|---|
| 80 | PURGE ;purge unprocessed document file
|
|---|
| 81 | N DIR,Y,X,X1,X2,RCDT
|
|---|
| 82 | S DIR("A")="How many days worth of DATA do you want to retain"
|
|---|
| 83 | S DIR(0)="N",DIR("?")="This is the number of days entries will remain in the file."
|
|---|
| 84 | D ^DIR
|
|---|
| 85 | I +Y<0!(Y="")!($E(Y,1)="^") G POUT
|
|---|
| 86 | S X1=DT,X2=-(+Y) D C^%DTC S RCDT=X
|
|---|
| 87 | S ZTRTN="QPURGE^RCFMOBR",ZTSAVE("RCDT")="",ZTDESC="Purge unprocessed document list",ZTIO="" D ^%ZTLOAD
|
|---|
| 88 | POUT K DIRUT,DIROUT,DTOUT,DUOUT Q
|
|---|
| 89 | ;
|
|---|
| 90 | QPURGE N DA,DIK
|
|---|
| 91 | S DIK="^RC(347,"
|
|---|
| 92 | Q:'$D(^RC(347))
|
|---|
| 93 | S DA=0 F S DA=$O(^RC(347,DA)) Q:'DA I $P(^(DA,0),U,5)<RCDT D ^DIK
|
|---|
| 94 | K RCDT
|
|---|
| 95 | Q
|
|---|
