source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCABJ1.m@ 836

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

initial load of WorldVistAEHR
File size: 2.2 KB
Line 
1PRCABJ1 ;WASH-ISC@ALTOONA,PA/LDB-NIGHTLY PROCESS FOR OPEN BILL UPDATE ;4/18/95 2:06 PM
2V ;;4.5;Accounts Receivable;**7**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Update Open status PREPAYMENT bills to REFUND REVIEW
5 ;Update Open status bills to Active or Cancellation status
6OPEN N DAY,BN,DEBTOR,DA,DIE,DR,P,AMT
7 S DAY=+$E(DT,6,7),DEBTOR=0 F S DEBTOR=$O(^RCD(340,"AC",DAY,DEBTOR)) Q:'DEBTOR D
8 .S BN=0 F S BN=$O(^PRCA(430,"AS",DEBTOR,$O(^PRCA(430.3,"AC",112,0)),BN)) Q:'BN D
9 ..S AMT=0 F P=1:1:5 S AMT=$P($G(^PRCA(430,+BN,7)),"^",P)+AMT
10 ..I $P($G(^PRCA(430,+BN,0)),"^",2)=$O(^PRCA(430.2,"AC",33,0)),AMT Q
11 ..S DIE="^PRCA(430,",DA=+BN,DR="8////^S X="_$S(AMT:$O(^PRCA(430.3,"AC",102,0)),1:$O(^PRCA(430.3,"AC",111,0))) D ^DIE K DA,DIE,DR
12 ..Q
13 .Q
14 Q
15REFUND NEW DEBTOR,DAY,BN
16 S DEBTOR=0,DAY=+$E(DT,6,7)+3#28 S:'DAY DAY=28
17 F S DEBTOR=$O(^RCD(340,"AC",DAY,DEBTOR)) Q:'DEBTOR D
18 .S BN=0 F S BN=$O(^PRCA(430,"AS",DEBTOR,$O(^PRCA(430.3,"AC",112,0)),BN)) Q:'BN D
19 ..I $P($G(^PRCA(430,+BN,0)),"^",2)=$O(^PRCA(430.2,"AC",33,0)) S X=$$EN^PRCARFU(+BN)
20 ..Q
21 .Q
22 Q
23STM ;RESET STATEMENT DATES
24 NEW DEB,DIE,DA,DR,TYPE,STAT,BILL,ACT
25 S STAT=+$O(^PRCA(430.3,"AC",102,0))
26 I 'STAT Q
27 F TYPE="VA(200,","DIC(4,","PRC(440," S DEB=0 F S DEB=$O(^RCD(340,"AB",TYPE,DEB)) Q:'DEB S X=$G(^RCD(340,DEB,0)) D:X]""
28 .I $P(X,"^",3),'$O(^PRCA(430,"AS",DEB,STAT,0)) S DIE="^RCD(340,",DR=".03////@",DA=DEB D ^DIE Q
29 .I '$P(X,"^",3),$O(^PRCA(430,"AS",DEB,STAT,0)) S DIE="^RCD(340,",DR=".03////^S X=+$E(DT,6,7) S:X>28 X=1",DA=DEB D ^DIE
30 .Q
31 S TYPE="DIC(36," S DEB=0 F S DEB=$O(^RCD(340,"AB",TYPE,DEB)) Q:'DEB D
32 .S ACT=0,BILL=0 F S BILL=$O(^PRCA(430,"AS",DEB,STAT,BILL)) Q:'BILL I $P($G(^PRCA(430,BILL,0)),"^",2)'=9 S ACT=1 Q
33 .S X=$G(^RCD(340,DEB,0))
34 .I $P(X,"^",3),'ACT S DIE="^RCD(340,",DR=".03////@",DA=DEB D ^DIE Q
35 .I '$P(X,"^",3),ACT S DIE="^RCD(340,",DR=".03////^S X=+$E(DT,6,7) S:X>28 X=1",DA=DEB D ^DIE
36 .Q
37 Q
38UDLIST ;Print Unprocessed Document List
39 N IOP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,RCFMDEV
40 S IOP=$P($G(^RC(342,1,0)),"^",8) I IOP]"" D
41 .S %ZIS="N0" D ^%ZIS Q:POP
42 .S ZTRTN="EN^RCFMUDL",ZTDTH=$H,RCFMDEV=ION_";"_IOST_";"_IOM_";"_IOSL_";"_$G(IO("DOC"))
43 .S ZTSAVE("RCFMDEV")="",ZTDESC="Unprocessed Document List"
44 .D ^%ZTLOAD,^%ZISC
45 Q
Note: See TracBrowser for help on using the repository browser.