source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAOLD.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRCAOLD ;SF-ISC/YJK-SETUP OLD ACCOUNTS RECEIVABLE ;8/9/96 9:32 AM
2 ;;4.5;Accounts Receivable;**40,67,158,153**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This sets up an old account for A/R. The account is classified
5 ;with category.
6 ;
7 W !!,*7,"This option can only be used to re-establish MCCR bills. ALL others",!,"MUST be set up as NEW bills.",!!,"**** THIS IS A REQUIREMENT OF FMS!! ****",!!
8 ;======================= SET UP OLD AR ==============================
9SETBIL K PRCA("CKSITE") D CKSITE^PRCAUDT Q:'$D(PRCA("CKSITE")) D LOOK G:X="" END D ENT G SETBIL
10 ;
11LOOK S:'$D(^PRCA(430,0)) ^(0)="ACCOUNTS RECEIVABLE^430I^^"
12 R !!,"ACCOUNTS RECEIVABLE BILL NO. : ",X:DTIME Q:('$T)!(X="") I X["^" S X="" Q
13 I "Nn"[$E(X) D I $P(X,"^")=-1 W *7,!!,$P(X,"^",2),! G LOOK
14 . S X=$$BNUM^RCMSNUM
15 . I $P(X,"^")'=-1 S X=$P(X,"-",2)
16 I (X'?1UN1UN4.5UN) W *7,!!,"Please enter 7 character bill number.",!,"It must be in the following format: K400001, K481234 or '(N)ew' to get",!,"the next available number. (Enter ""^"" to exit)",! G LOOK
17 I ($D(^PRCA(430,"D",X)))!($D(^PRCA(430,"B",PRCA("SITE")_"-"_X))) W *7,!!,"SORRY ! THIS NUMBER HAS BEEN ALREADY ASSIGNED TO A BILL. IT MUST BE NEW ENTRY",! G LOOK
18 Q
19ENT S X=PRCA("SITE")_"-"_X W " ",X S DIC="^PRCA(430,",DIC(0)="XL",DLAYGO=430 D ^DIC K DLAYGO,DIC
20 Q:Y<0 S (X,D0,PRCABN)=+Y,PRCA("MESS1")="THE ACCOUNT WILL REMAIN INCOMPLETE OLD BILL AND SHOULD BE EDITED."
21 K PRCADIOK,PRCADEL D EDT^PRCAEOL
22DELETE I $D(PRCADEL) S PRCACOMM="USER CANCELED" D DELETE^PRCABIL4 K PRCACOMM W !,*7,"DELETED",!
23END I +$G(PRCABN),$P($G(^PRCA(430,PRCABN,0)),U,8)=$O(^PRCA(430.3,"AC",102,"")) D PREPAY^RCBEPAYP(PRCABN)
24 L -^PRCA(430,+$G(PRCABN)) K PRCAPO,PRCADINO,PRCA("MESS1"),PRCA("MESS2"),PRCABN,PRCADEL,PRCA("CKSITE"),DIC Q
25 ;
26PATREF ;enter PAT REF # to the old bill.
27 K PRCAPO S PRCAKDA=DA,PRCAREF=1 W !,"PAT REFERENCE NUMBER: " R X:DTIME I X=U W *7," (REQUIRED !)" Q
28 I (X["?")!(X'?3UN2N1UN) W *7,!,"Please enter a PAT Reference Number assigned to this bill.",!,"Enter 6 number/characters, e.g. 8KA111, K8111A or 8K111A",! G PATREF
29 S X=$$SITE^RCMSITE_"-"_X I $D(^PRC(442,"B",X)) S PRCAPO=$O(^(X,0)) D PATUP Q
30 S DIC="^PRC(442,",DIC(0)="QL",DLAYGO=442 D ^DIC I Y<0 K DLAYGO Q
31 S PRCAPO=+Y
32PATUP S $P(^PRC(442,PRCAPO,0),U,2)=24,^PRC(442,"F",24,PRCAPO)="" S:$D(PRCABN) $P(^PRC(442,PRCAPO,1),U,16)=$P(^PRCA(430,PRCABN,0),U,9)
33 S DA=PRCAKDA K PRCAKDA,PRCAREF S Y="@13" Q
34HELP W !!,"Please enter a six character bill number. You may use the PAT number.",!,"It must contain at least one alpha character within the first five spaces."
35 W !,"e.g. 8K1234, K81234, 9M234A (Enter ""^"" to exit)",! Q
Note: See TracBrowser for help on using the repository browser.