source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCABIL1.m@ 1154

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

initial load of WorldVistAEHR
File size: 4.5 KB
Line 
1PRCABIL1 ;SF-ISC/RSD-ENTER BILL INFO ;10/16/96 7:04 PM
2V ;;4.5;Accounts Receivable;**57,64,109,147,220**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN1 ;ENTER NEW BILL
5 D ST Q:'% N CP
6EN10 D EN^PRCABIL2 G Q:'$D(PRCABN) S $P(^PRCA(430,PRCABN,0),"^",8)=$O(^PRCA(430.3,"AC",201,0)) D EN G EN10
7EN2 ;EDIT BILL
8EN20 D SVC^PRCABIL Q:'$D(PRCAP("S")) S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0>199,Z0<210,'$P($G(^PRCA(430,Y,3)),U,3),+$P($G(^(100)),U,2)="_PRCAP("S")
9 D BILLN^PRCAUTL G Q:'$D(PRCABN) D EN G EN20
10EN4 ;CANCEL BILL
11EN40 D SVC^PRCABIL Q:'$D(PRCAP("S")) S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0>199,Z0<210,$D(^PRCA(430,Y,100)),+$P(^(100),U,2)="_PRCAP("S")
12 D BILLN^PRCAUTL G Q:'$D(PRCABN)
13YN S %=2 W !," Sure you want to cancel this Bill" D YN^DICN
14 I %=0 W !,*7,"Answer 'Yes' or 'No' " G YN
15 I %'=1 D Q G EN40
16 S $P(^PRCA(430,PRCABN,0),"^",14)=DT,$P(^(0),"^",17)=DUZ,$P(^(9),"^",6)=$P(^(0),"^",8),PRCA("STATUS")=$O(^PRCA(430.3,"AC",210,0)) D UPSTATS^PRCAUT2 K PRCA("STATUS") D Q G EN40
17EN K PRCADFM S DA=PRCABN D LCK G Q:'$D(DA)
18 S DIE="^PRCA(430,"
19 I $D(RCAMEND) S X=+^PRCA(430,DA,100) I X?1N,X<4,X>0 G FORM
20 S DR="100" D ^DIE G:X'?1N Q
21FORM N PRCACAT,PRCAFUND
22 S DR="[PRCA BILL "_$P("1081^1080^1114","^",X)_"]",PRCABT=X D ^DIE
23 S:$D(DUZ) $P(^PRCA(430,PRCABN,9),U,8)=DUZ
24 S PRCACAT=$P(^PRCA(430,PRCABN,0),U,2)
25 I PRCACAT>39,PRCACAT<45 D
26 .S X=PRCACAT,PRCAFUND=$S(X=40:"05",X=41:"06",X=42:"07",X=43:"08",1:"10"),PRCAFUND=5287_PRCAFUND
27 .S DR="259////"_"09;203////^S X=PRCAFUND"
28 .;I PRCAFUND'=528707 S DR=DR_";258////1"
29 .D ^DIE
30 .Q
31 I $P(^PRCA(430,PRCABN,0),U,9)=""!('$D(^(100))!('$D(^(101)))) D MESG W !,"Bill is incomplete and must be re-edited !",*7 G Q
32 D EN4^PRCABIL S PRCAMT1=0,PRCAMTY=0,DIK="^PRCA(430,PRCABN,2,"
33 F PRCAI=0:0 S PRCAI=$O(^PRCA(430,PRCABN,2,PRCAI)) Q:'PRCAI I $D(^(PRCAI,0)) S X=^(0) I $P(X,"^",8)]"" S PRCAMT1=PRCAMT1+$P(X,"^",8),PRCAMTY=PRCAMTY+1
34 I 'PRCAMT1 W !!,"Fiscal Year Amount was not entered ! Bill is incomplete",*7 G Q
35 I PRCAMTY>1 W !!,"Multiple Fiscal Years are not allowed at this time !",!,"Bill is incomplete and must be re-edited.",*7 G Q
36 ;S DIE=DIK,DA(1)=PRCABN,DA=+$O(^PRCA(430,PRCABN,2,0)),DR=".01;7" S:'DA ^PRCA(430,PRCABN,2,0)="^430.01" D ^DIE
37 I PRCAMT1'=PRCAMT,PRCABT'=1 W !!,"Fiscal Year Amounts do not equal the total bill amount !",!,"Bill is incomplete and must be re-edited !",*7 G Q
38 I PRCAMT1'=PRCAMT,PRCABT=1 D ;
39 . N DIE,DA,DR
40 . S PRCAMT1=PRCAMT
41 . S DIE="^PRCA(430,PRCABN,2,"
42 . S DA(1)=PRCABN
43 . S DA=+$O(^PRCA(430,PRCABN,2,0))
44 . S DR="1///"_PRCAMT1
45 . QUIT:'DA
46 . ;
47 . DO ^DIE
48 ;
49 S Y=$P(^PRCA(430,PRCABN,0),"^",9),Y=Y_"^"_$P(^RCD(340,Y,0),"^",1)
50 G:$P(Y,";",2)="DPT("!($P(Y,";",2)="DIC(36,") CONT
51 S PRCANODE=.11 S:$P(Y,";",2)="DIC(4," PRCANODE=1 S PRCANODE="^"_$P(Y,";",2)_+$P(Y,"^",2)_","_PRCANODE_")",PRCANODE=$G(@PRCANODE)
52 I $P(PRCANODE,"^",1)="" S DR=$P(Y,"^",2),%=1 W !," (No Street Address) Edit Debtor Address: " D YN^DICN,EN1^RCAM(DR):%=1 K DIE,DR,DA
53CONT S Y=^PRCA(430,PRCABN,0),$P(Y,"^",3)=PRCAMT,PRCA("STATUS")=$O(^PRCA(430.3,"AC",205,0)),^PRCA(430,PRCABN,0)=Y,$P(^PRCA(430,PRCABN,7),"^")=PRCAMT
54 I '$D(RCAMEND) S DIE="^PRCA(430,",DA=PRCABN,DR="8////"_PRCA("STATUS")_"" D ^DIE K DIE,DR,DA
55DISP S %=1,PRCADFM=1 W !," Display/Print Bill:"
56 K IOP D YN^DICN
57 I %=0 W !,*7,"Answer 'Yes' or 'No' " G DISP
58 D ^PRCABD:%=1
59Q L -^PRCA(430,+$G(PRCABN),0)
60 K %,%Y,A,B,C,D0,DA,DIC,DIE,DIK,DR,I,PRCA,PRCABC,PRCABN,PRCABT,PRCADFM,PRCAI,PRCAKCT,PRCANM,PRCARN,PRCATIME,PRCAMT,PRCAMTY,PRCANM,PRCANODE,PRCAMT1,PRCAMT2,PRCAQ,PRCAP,PRCAT,PRCATY,PRCAX,X,Y,Z0,ZRTN,ZTSK Q
61LCK L +^PRCA(430,DA,0):0 I Q
62 W !,"ANOTHER USER IS EDITING THIS ENTRY !" K DA Q
63CP ;CONTROL POINT LOOK-UP
64 N DIC,PRC,DIE,DA,DR,X,Y,PRCSIP,PRCSI
65 S PRC("SITE")=$S($G(PRCA("SITE")):PRCA("SITE"),1:$$SITE^RCMSITE)
66 ;S PRC("SITE")=$$SITE^RCMSITE
67 S DIC("B")=$P($G(^PRCA(430,PRCABN,11)),U)
68 D CP^PRCSUT I '$G(PRC("CP")) Q
69 I PRC("CP")<0 Q
70 S $P(^PRCA(430,PRCABN,11),U)=PRC("CP")
71 Q
72ST D CKSITE^PRCAUDT S %=$D(PRCA("CKSITE")) Q
73ST1 D SVC^PRCABIL S %=$S($D(PRCAP("S")):1,1:0) Q:%
74 K PRCAP Q
75DIP D SVC^PRCABIL Q:'$D(PRCAP("S"))
76 S FR=PRCAP("S")_",?,@",TO=PRCAP("S")_",?",L=0,DIC="^PRCA(430,",FLDS="[PRCA BILL LIST]",BY="@INTERNAL(SERVICE),BILL NO.,FORM TYPE" D EN1^DIP K BY,DHD,DIC,FLDS,FR,L,PRCAP,TO Q
77MESG I $P(^PRCA(430,PRCABN,0),U,9)="" W !,?3,"Debtor (or Payer) data is missing."
78 I '$D(^PRCA(430,PRCABN,100)) W !,?3,"Service (or Section) , Form type or Voucher number data is missing."
79 I '$D(^PRCA(430,PRCABN,101)) W !,?3,"Date of Charge data does not exist."
80 W ! Q
Note: See TracBrowser for help on using the repository browser.