source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAHOL.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRCAHOL ;SF-ISC/YJK-HOLD,REMOVE,LIST LETTERS ;9/10/93 9:12 AM
2V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This releases the holding Collection Letter.
5 ;This lists the holding Collection Letters.
6HOLD ;============== HOLD SENDING LETTER =================================
7 N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
8 S DIC="^PRCA(430,",DIC(0)="AEQM" D ^DIC G:Y<0 HEND S DA=+Y
9 I $P($G(^RCD(340,+$P(^PRCA(430,DA,0),"^",9),0)),"^")[";DPT(" D G HOLD
10 .W *7,!!,"Patient bills can no longer be put on hold!",!
11 .S X=$G(^PRCA(430,DA,1))
12 .I $P(X,"^")]"" W !,"Hold Letter Date: ",$$SLH^RCFN01($P(X,"^"))
13 .I $P(X,"^",2)]"" W !,"Hold Letter Reason: ",$P("PERSONAL LETTER^PHONE CALL^PERSONAL VISIT^OTHERS","^",$F("LPVO",$P(X,"^",2))-1)
14 .I $P(X,"^",3)]"" W !,"Hold Letter Comment: ",$P(X,"^",3)
15 .I $P(X,"^")]""!($P(X,"^",2)]"")!($P(X,"^",3)]"") W !!,"NOTICE: 'HOLD LETTER' information deleted from bill",!!,"Please use the 'Suspend an AR Bill' option if you want this bill on 'hold'.",! S $P(^PRCA(430,DA,1),"^",1,3)=""
16 .Q
17 S DR="21;22;23",DIE=DIC D ^DIE G HOLD
18HEND K DA,DIC,DIE,DR Q
19RELHOLD ;=============== RELEASE HOLDING LETTER =============================
20DIC N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
21 S DIC="^PRCA(430,",DIC(0)="AEQM" D ^DIC G:Y<0 REND S DA=+Y
22ASK S %=2 W !!,"ARE YOU SURE YOU WANT TO REMOVE HOLD ON FOLLOW-UP FOR THIS ACCOUNT " D YN^DICN I %=0 D YN^PRCAMESG G ASK
23 G:%'=1 REND
24 K ^PRCA(430,DA,1) W *7,!!,"OK, THE HOLD HAS BEEN REMOVED !",! G RELHOLD
25NOTH W !," <NOTHING CHANGED> " G RELHOLD
26REND K DIC,DA,% Q
27 ;
28LISTHOL ;================= LIST OF HOLDING LETTERS ==========================
29 S DIC="^PRCA(430,",BY="HOLD LETTER DATE,BILL NO.",FR=",",TO=",",L=0,DHD="LIST OF ACCOUNTS WITH HOLDS",FLDS="[PRCA LIST HOLD]" D EN1^DIP
30LEND K FLDS,L,FR,TO,DIC,DHD,BY Q
Note: See TracBrowser for help on using the repository browser.