source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAEOL.m@ 1042

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PRCAEOL ;SF-ISC/YJK-EDIT INCOMPLETE OLD BILL ;2/28/95 10:35 AM
2V ;;4.5;Accounts Receivable;**67,153**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This edits incomplete old bill. The account is classified
5 ;with category.
6 ;
7 ;===================== EDIT INCOMPLETE AR ===========================
8EDIN ;edit incomplete accounts receivable.
9 D CKSITE^PRCAUDT G:'$D(PRCA("SITE")) END
10EN S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0=106"
11 D DIC^PRCAUDT G:'$D(PRCABN) END S PRCA("MESS1")="THE ACCOUNT IS STILL INCOMPLETE OLD BILL"
12 K PRCADINO D EDT
13 I $G(PRCABN)>0,$P(^PRCA(430,PRCABN,0),U,8)=$O(^PRCA(430.3,"AC",102,"")) D PREPAY^RCBEPAYP(PRCABN)
14 D KILLV G EDIN
15EDT D DIE Q:PRCA("LOCK")=1 I $D(PRCADINO),($P(^PRCA(430,PRCABN,0),U,2)="")!($P(^(0),U,9)="") S PRCADEL=1 Q
16 I $D(PRCADINO) W !!,*7,PRCA("MESS1"),!! Q
17 D COMMENTS^PRCAUT3 G:$D(PRCA("EXIT")) DIP1
18DIP S PRCAT=+$P(^PRCA(430,PRCABN,0),U,2) D:$P(^PRCA(430.2,PRCAT,0),U,3)>0 SEGMT S PRCAT=$S($D(^PRCA(430.2,PRCAT,0)):$P(^(0),U,6),1:"") D DISPL S PRCAOK=0 D ASK1 G:$D(PRCA("EXIT")) DIP1
19 I PRCAOK=1 G:'$D(PRCANM) DIP1 W !! D KILLV Q
20 D ASK2 I PRCAOK=1 D DIE G DIP
21DIP1 W !!,PRCA("MESS1"),! S PRCA("STATUS")=$O(^PRCA(430.3,"AC",106,"")) D UPSTATS^PRCAUT2 K PRCA("STATUS") D KILLV Q ;end of EDIN
22KILLV L -^PRCA(430,+$G(PRCABN))
23 K PRCADEL,DIC,DR,DIE,PRCAT,PRCAGLN,PRCA("CKSITE"),PRCADINO,PRCAOK,PRCA("MESS1"),PRCA("EXIT"),PRCA("MESS2"),PRCAT,PRCANM,PRCADEL,PRCATY Q
24END D KILLV K PRCABN,PRCAREF,PRCA Q
25 ;======================= SUBROUTINES ================================
26DIE K PRCAT W ! S DA=PRCABN,DIC="^PRCA(430,",PRCA("LOCK")=0 D LOCKF^PRCAWO1 Q:PRCA("LOCK")=1 S DIE=DIC,DR="[PRCA CAT SET]" D ^DIE I +$P(^PRCA(430,PRCABN,0),U,2)'>0 S PRCADINO="" Q
27 I '$$ACCK^PRCAACC(PRCABN) W !!,*7,"This catergory of bill CAN NOT be re-established.",! S PRCADINO="" Q
28 S PRCAT=$P(^PRCA(430.2,+$P(^PRCA(430,PRCABN,0),U,2),0),U,6),PRCAGLN=$P(^(0),U,4) S:$P(^(0),U,7)=24 PRCAT("C")=1
29D1 S PRCAREF=1,DR="[PRCA OLD SET]" D ^DIE K DR
30 I $P(^PRCA(430,PRCABN,0),U,9)'>0 W !,"Debtor input is not entered.",! S PRCADINO="" Q
31 I +$P(^PRCA(430,PRCABN,0),U,5)'>0 W !,"'Bill Resulting From' input is not set.",! S PRCADINO="" Q
32 Q
33DISPL ;display the accounts receivable data user has entered.
34 Q:'$D(PRCABN) I '$D(IOF) S IOP="" D ^%ZIS
35 S D0=PRCABN K ^UTILITY($J,"W") S PRCAIO=IO,PRCAIO(0)=IO(0) D PROC^PRCAPRO Q
36ASK2 S %=2 W !!,"DO YOU WANT TO EDIT THE DATA" D YN^DICN Q:(%<0)!(%=2)
37 I %=0 W " ANSWER 'Y'(YES) OR 'N'(NO)" G ASK2
38 S PRCAOK=1 Q
39ASK1 S %=2 W !!,"IS THIS DATA CORRECT" D YN^DICN I %<0 S PRCA("EXIT")="" Q
40 I %=0 W " ANSWER 'Y'(YES) OR 'N'(NO)" G ASK1
41 Q:%'=1 I $P(^PRCA(430,PRCABN,0),U,8)=$O(^PRCA(430.3,"AC",106,"")) W !,"This account has an 'OLD BILL' status and should be edited.",! S PRCAOLD="",DIE="^PRCA(430,",DA=PRCABN,DR="8" D ^DIE K DIE,DR,PRCAOLD
42 I $P(^PRCA(430,PRCABN,0),U,8)=$O(^PRCA(430.3,"AC",106,"")) W !,"This account still has an 'OLD BILL' status." Q
43 S $P(^PRCA(430,PRCABN,9),U,6)=$O(^PRCA(430.3,"AC",106,""))
44 S PRCAOK=1,DA=PRCABN D SIG^PRCASIG,NOW^%DTC
45 I $D(PRCANM) S $P(^PRCA(430,PRCABN,9),U,1,3)=+DUZ_U_PRCANM_U_%
46 Q
47DELETE ;delete new AR which has no category and debtor field.
48 S PRCACOMM="USER CANCELED" D DELETE^PRCABIL4 K PRCACOMM
49 W *7,!,"The accounts receivable has been deleted!",! Q
50SEGMT ;save segment number in the file 430 for AMIS report.
51 Q:'$D(PRCAT)!$P(^PRCA(430,PRCABN,0),"^",21) N PRCARI,Y
52 S PRCARI=$O(^PRCA(430.2,"AC",21,0))
53 I PRCAT=PRCARI S X=PRCABN D:$D(^DGCR(399,PRCABN)) ^IBCAMS S:'$D(^DGCR(399,PRCABN)) Y=297
54 S:'$D(Y) Y=-1 S %=$S(PRCARI=PRCAT&(Y<1):"0",PRCARI=PRCAT:Y,$D(^PRCA(430.2,PRCAT,0)):$P(^(0),U,3),1:"0")
55 I %=240 S %=$S($P(^PRCA(430,PRCABN,0),U,16)>0:$P(^PRCA(430.2,$P(^PRCA(430,PRCABN,0),U,16),0),U,3),1:%)
56 S $P(^PRCA(430,PRCABN,0),U,21)=% K %,PRCARI,Y Q
Note: See TracBrowser for help on using the repository browser.