Index: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMOBR.m
===================================================================
--- WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMOBR.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCFMOBR.m	(revision 623)
@@ -1,100 +1,95 @@
-RCFMOBR	;WASH-ISC@ALTOONA,PA/RWT-BILL RECONCILIATIONS LIST ;11/20/96  2:30 PM
-V	;;4.5;Accounts Receivable;**2,20,40,53,249**;Mar 20, 1995;Build 2
-	;;Per VHA Directive 10-93-142, this routine should not be modified.
-EN	;Creates report from OBR data in file 423.6
-	;
-	;      OBR Data Structure used by this routine
-	; ^TMP("OBR",$J,SITE,"NOT IN AR")=NextRec^TotalItems^TotalFMSAmt
-	; ^TMP("OBR",$J,SITE,"NOT IN FMS")=NextRec^TotalItems^TotalARAmt
-	; ^TMP("OBR",$J,SITE,"DISCREPANCY")=NextRec^TotalItems^TotalFMSAmt^TotalARAmt
-	; ^TMP("OBR",$J,"BN",BILLNUMBER)=[423.6 rec] <-- x-ref of FMS Bills
-	; ^TMP("OBR",$J,"REPORT","1")="LINE 1"
-	; ^TMP("OBR",$J","REPORT,"2")="LINE 2"
-	;
-	; Descriptions of modules:
-	;    PROCFMS  -  loop through FMS bills (^PRCF(423.6)) updating
-	;                global ^TMP("OBR",$J,"BN") while also checking
-	;                for invalid AR bills
-	;    PROCAR   -  loop through all Active AR Bills comparing amounts
-	;                and looking for Detail bills not found in FMS
-	;    BUILDRPT -  Prepares report in global ^TMP("OBR",$J,"REPORT")
-	;
-	N X,Y,OBR,A0,ERR
-	K ^TMP("OBR",$J)
-	;
-	I $G(PRCADA) D PROCESS(PRCADA) G Q1
-	S OBR="OBR-",ERR=-1
-	F  S OBR=$O(^PRCF(423.6,"B",OBR)) Q:OBR=""!(OBR'["OBR-")  D
-	   .I $O(^PRCF(423.6,"B",OBR))'["OBR-" D  Q
-	      ..S A0=$O(^PRCF(423.6,"B",OBR,0))
-	      ..S ERR=0 D PROCESS(A0)
-	I ERR D PROCESS(ERR)
-Q1	K ^TMP("OBR",$J)
-	Q
-PROCESS(A0)	N X,X1,X2,Y,SN,PARENT,XMTEXT,XMSUB,XMSENDER,XMDUZ,ERR,DATE,FMSDATE
-	S ERR=0 D
-	  .I '$D(^PRCF(423.6,A0,0)) S ERR=-1 Q
-	  .I $E(^PRCF(423.6,A0,0),1,3)'["OBR" S ERR=-1 Q
-	  .S X=$P(^PRCF(423.6,A0,0),"-",2)
-	  .S X=$E(X,5,6)_"-"_$E(X,7,8)_"-"_$E(X,1,4) D ^%DT ;Y is defined
-	  .S PARENT=$P($P(^PRCF(423.6,A0,0),"-",5),U)
-	  .;
-	  .D PROCFMS^RCFMOBR1(A0)
-	  .D PROCAR^RCFMOBR1(A0)
-	  .D BUILDRPT^RCFMOBR2(PARENT)
-	;
-	I '$D(PARENT) S PARENT=$$SITE^RCMSITE
-	S PARENT=$P(^DIC(4,+$O(^DIC(4,"D",PARENT,0)),0),U)
-	;
-	I '$D(Y) S Y=DT  ;Y may be defined from %DT call above
-	S X1=Y,X2=($E(Y,6,7)+1)*-1 D C^%DTC,YX^%DTC
-	S FMSDATE=$P(Y,"@"),FMSDATE=$E(FMSDATE,1,4)_$E(FMSDATE,9,12)
-	D NOW^%DTC S DATE=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
-	; - Transmits report via e-mail to FMS mail group
-	S XMSUB="FMS "_FMSDATE_" RECONCILIATION ("_DATE_") "
-	S XMSUB=XMSUB_PARENT
-	I ERR D
-	  .S ^TMP("OBR",$J,"REPORT",1)="Date of Report: "_DATE
-	  .S ^TMP("OBR",$J,"REPORT",2)="NOTE: This report compares your current A/R records with data received from"
-	  .S ^TMP("OBR",$J,"REPORT",3)="      FMS on the last day of the previous accounting period."
-	  .S ^TMP("OBR",$J,"REPORT",4)=""
-	  .S ^TMP("OBR",$J,"REPORT",5)="No FMS data exists to reconcile!"
-	S XMTEXT="^TMP(""OBR"",$J,""REPORT"","
-	S XMDUZ="Accounts Receivable Package",XMY("G.FMS")="",XMY(DUZ)="" D ^XMD
-	Q
-EN2	;Entry point from Regenerate Prior Month OBRs option
-	N DIR,PRCADA,Y
-	W !!,"This option will transmit the OBR report(s) to you and members"
-	W !,"of the G.FMS mail group."
-	W !!,"NOTE: Depending on the number of active AR bills in your system,"
-	W !,"      this may take awhile to run.",!
-	S DIR(0)="YO",DIR("A")="Are you sure you want to do this",DIR("B")="NO"
-	D ^DIR Q:Y'=1  S ZTRTN="EN^RCFMOBR",ZTDESC="Prior Month OBRs"
-	S ZTIO="" D ^%ZTLOAD Q
-	;
-EN3	;Deletes OBRs over 60 days old
-	N A0,A1,A2,DA,DIK,X,X1,X2
-	S A0="OBR-" F  S A0=$O(^PRCF(423.6,"B",A0)) Q:A0=""!(A0'["OBR-")  S A1=$E($P(A0,"-",2),1,8),A2=0 F  S A2=$O(^PRCF(423.6,"B",A0,A2)) Q:+A2=0  D
-	.S X1=DT,X2=$$RCDT(A1) D ^%DTC I X>60 S DIK="^PRCF(423.6,",DA=A2 D ^DIK
-	Q
-RCDT(A1)	;Convert yyyymmdd to FM date
-	N X,Y
-	S X=A1,X=$E(X,5,6)_" "_$E(X,7,8)_", "_$E(X,1,4)
-	D ^%DT
-	Q Y
-PURGE	;purge unprocessed document file
-	N DIR,Y,X,X1,X2,RCDT
-	S DIR("A")="How many days worth of DATA do you want to retain"
-	S DIR(0)="N",DIR("?")="This is the number of days entries will remain in the file."
-	D ^DIR
-	I +Y<0!(Y="")!($E(Y,1)="^") G POUT
-	S X1=DT,X2=-(+Y) D C^%DTC S RCDT=X
-	S ZTRTN="QPURGE^RCFMOBR",ZTSAVE("RCDT")="",ZTDESC="Purge unprocessed document list",ZTIO="" D ^%ZTLOAD
-POUT	K DIRUT,DIROUT,DTOUT,DUOUT Q
-	;
-QPURGE	N DA,DIK
-	S DIK="^RC(347,"
-	Q:'$D(^RC(347))
-	S DA=0 F  S DA=$O(^RC(347,DA)) Q:'DA  I $P(^(DA,0),U,5)<RCDT D ^DIK
-	K RCDT
-	Q
+RCFMOBR ;WASH-ISC@ALTOONA,PA/RWT-BILL RECONCILIATIONS LIST ;11/20/96  2:30 PM
+V ;;4.5;Accounts Receivable;**2,20,40,53**;Mar 20, 1995
+ ;;Per VHA Directive 10-93-142, this routine should not be modified.
+EN ;Creates report from OBR data in file 423.6
+ ;
+ ;      OBR Data Structure used by this routine
+ ; ^TMP("OBR",$J,SITE,"NOT IN AR")=NextRec^TotalItems^TotalFMSAmt
+ ; ^TMP("OBR",$J,SITE,"NOT IN FMS")=NextRec^TotalItems^TotalARAmt
+ ; ^TMP("OBR",$J,SITE,"DISCREPANCY")=NextRec^TotalItems^TotalFMSAmt^TotalARAmt
+ ; ^TMP("OBR",$J,"BN",BILLNUMBER)=[423.6 rec] <-- x-ref of FMS Bills
+ ; ^TMP("OBR",$J,"REPORT","1")="LINE 1"
+ ; ^TMP("OBR",$J","REPORT,"2")="LINE 2"
+ ;
+ ; Descriptions of modules:
+ ;    PROCFMS  -  loop through FMS bills (^PRCF(423.6)) updating
+ ;                global ^TMP("OBR",$J,"BN") while also checking
+ ;                for invalid AR bills
+ ;    PROCAR   -  loop through all Active AR Bills comparing amounts
+ ;                and looking for Detail bills not found in FMS
+ ;    BUILDRPT -  Prepares report in global ^TMP("OBR",$J,"REPORT")
+ ;
+ N X,Y,OBR,A0,ERR
+ K ^TMP("OBR",$J)
+ ;
+ I $G(PRCADA) D PROCESS(PRCADA) G Q1
+ S OBR="OBR-",ERR=-1
+ F  S OBR=$O(^PRCF(423.6,"B",OBR)) Q:OBR=""!(OBR'["OBR-")  D
+    .I $O(^PRCF(423.6,"B",OBR))'["OBR-" D  Q
+       ..S A0=$O(^PRCF(423.6,"B",OBR,0))
+       ..S ERR=0 D PROCESS(A0)
+ I ERR D PROCESS(ERR)
+Q1 K ^TMP("OBR",$J)
+ Q
+PROCESS(A0) N X,X1,X2,Y,SN,PARENT,XMTEXT,XMSUB,XMSENDER,XMDUZ,ERR,DATE,FMSDATE
+ S ERR=0 D
+   .I '$D(^PRCF(423.6,A0,0)) S ERR=-1 Q
+   .I $E(^PRCF(423.6,A0,0),1,3)'["OBR" S ERR=-1 Q
+   .S X=$P(^PRCF(423.6,A0,0),"-",2)
+   .S X=$E(X,5,6)_"-"_$E(X,7,8)_"-"_$E(X,1,4) D ^%DT ;Y is defined
+   .S PARENT=$P($P(^PRCF(423.6,A0,0),"-",5),U)
+   .;
+   .D PROCFMS^RCFMOBR1(A0)
+   .D PROCAR^RCFMOBR1(A0)
+   .D BUILDRPT^RCFMOBR2(PARENT)
+ ;
+ I '$D(PARENT) S PARENT=$$SITE^RCMSITE
+ S PARENT=$P(^DIC(4,+$O(^DIC(4,"D",PARENT,0)),0),U)
+ ;
+ I '$D(Y) S Y=DT  ;Y may be defined from %DT call above
+ S X1=Y,X2=($E(Y,6,7)+1)*-1 D C^%DTC,YX^%DTC
+ S FMSDATE=$P(Y,"@"),FMSDATE=$E(FMSDATE,1,4)_$E(FMSDATE,9,12)
+ D NOW^%DTC S DATE=$E(X,4,5)_"-"_$E(X,6,7)_"-"_$E(X,2,3)
+ ; - Transmits report via e-mail to FMS mail group
+ S XMSUB="FMS "_FMSDATE_" RECONCILIATION ("_DATE_") "
+ S XMSUB=XMSUB_PARENT
+ I ERR D
+   .S ^TMP("OBR",$J,"REPORT",1)="Date of Report: "_DATE
+   .S ^TMP("OBR",$J,"REPORT",2)="NOTE: This report compares your current A/R records with data received from"
+   .S ^TMP("OBR",$J,"REPORT",3)="      FMS on the last day of the previous accounting period."
+   .S ^TMP("OBR",$J,"REPORT",4)=""
+   .S ^TMP("OBR",$J,"REPORT",5)="No FMS data exists to reconcile!"
+ S XMTEXT="^TMP(""OBR"",$J,""REPORT"","
+ S XMDUZ="Accounts Receivable Package",XMY("G.FMS")="",XMY(DUZ)="" D ^XMD
+ Q
+EN2 ;Entry point from Regenerate Prior Month OBRs option
+ N DIR,PRCADA,Y
+ W !!,"This option will transmit the OBR report(s) to you and members"
+ W !,"of the G.FMS mail group."
+ W !!,"NOTE: Depending on the number of active AR bills in your system,"
+ W !,"      this may take awhile to run.",!
+ S DIR(0)="YO",DIR("A")="Are you sure you want to do this",DIR("B")="NO"
+ D ^DIR Q:Y'=1  S ZTRTN="EN^RCFMOBR",ZTDESC="Prior Month OBRs"
+ S ZTIO="" D ^%ZTLOAD Q
+ ;
+EN3 ;Deletes OBRs over 60 days old
+ N A0,A1,A2,DA,DIK,X,X1,X2
+ 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
+ .S X1=DT,X2=A1 D ^%DTC I X>60 S DIK="^PRCF(423.6,",DA=A2 D ^DIK
+ Q
+PURGE ;purge unprocessed document file
+ N DIR,Y,X,X1,X2,RCDT
+ S DIR("A")="How many days worth of DATA do you want to retain"
+ S DIR(0)="N",DIR("?")="This is the number of days entries will remain in the file."
+ D ^DIR
+ I +Y<0!(Y="")!($E(Y,1)="^") G POUT
+ S X1=DT,X2=-(+Y) D C^%DTC S RCDT=X
+ S ZTRTN="QPURGE^RCFMOBR",ZTSAVE("RCDT")="",ZTDESC="Purge unprocessed document list",ZTIO="" D ^%ZTLOAD
+POUT K DIRUT,DIROUT,DTOUT,DUOUT Q
+ ;
+QPURGE N DA,DIK
+ S DIK="^RC(347,"
+ Q:'$D(^RC(347))
+ S DA=0 F  S DA=$O(^RC(347,DA)) Q:'DA  I $P(^(DA,0),U,5)<RCDT D ^DIK
+ K RCDT
+ Q
