PRCAHOL ;SF-ISC/YJK-HOLD,REMOVE,LIST LETTERS ;9/10/93 9:12 AM
V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;This releases the holding Collection Letter.
;This lists the holding Collection Letters.
HOLD ;============== HOLD SENDING LETTER =================================
N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S DIC="^PRCA(430,",DIC(0)="AEQM" D ^DIC G:Y<0 HEND S DA=+Y
I $P($G(^RCD(340,+$P(^PRCA(430,DA,0),"^",9),0)),"^")[";DPT(" D G HOLD
.W *7,!!,"Patient bills can no longer be put on hold!",!
.S X=$G(^PRCA(430,DA,1))
.I $P(X,"^")]"" W !,"Hold Letter Date: ",$$SLH^RCFN01($P(X,"^"))
.I $P(X,"^",2)]"" W !,"Hold Letter Reason: ",$P("PERSONAL LETTER^PHONE CALL^PERSONAL VISIT^OTHERS","^",$F("LPVO",$P(X,"^",2))-1)
.I $P(X,"^",3)]"" W !,"Hold Letter Comment: ",$P(X,"^",3)
.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)=""
.Q
S DR="21;22;23",DIE=DIC D ^DIE G HOLD
HEND K DA,DIC,DIE,DR Q
RELHOLD ;=============== RELEASE HOLDING LETTER =============================
DIC N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
S DIC="^PRCA(430,",DIC(0)="AEQM" D ^DIC G:Y<0 REND S DA=+Y
ASK 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
G:%'=1 REND
K ^PRCA(430,DA,1) W *7,!!,"OK, THE HOLD HAS BEEN REMOVED !",! G RELHOLD
NOTH W !," <NOTHING CHANGED> " G RELHOLD
REND K DIC,DA,% Q
;
LISTHOL ;================= LIST OF HOLDING LETTERS ==========================
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
LEND K FLDS,L,FR,TO,DIC,DHD,BY Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAHOL 1890 printed Oct 16, 2024@17:40:43 Page 2
PRCAHOL ;SF-ISC/YJK-HOLD,REMOVE,LIST LETTERS ;9/10/93 9:12 AM
V ;;4.5;Accounts Receivable;**198**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;This releases the holding Collection Letter.
+3 ;This lists the holding Collection Letters.
HOLD ;============== HOLD SENDING LETTER =================================
+1 NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+2 SET DIC="^PRCA(430,"
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
GOTO HEND
SET DA=+Y
+3 IF $PIECE($GET(^RCD(340,+$PIECE(^PRCA(430,DA,0),"^",9),0)),"^")[";DPT("
Begin DoDot:1
+4 WRITE *7,!!,"Patient bills can no longer be put on hold!",!
+5 SET X=$GET(^PRCA(430,DA,1))
+6 IF $PIECE(X,"^")]""
WRITE !,"Hold Letter Date: ",$$SLH^RCFN01($PIECE(X,"^"))
+7 IF $PIECE(X,"^",2)]""
WRITE !,"Hold Letter Reason: ",$PIECE("PERSONAL LETTER^PHONE CALL^PERSONAL VISIT^OTHERS","^",$FIND("LPVO",$PIECE(X,"^",2))-1)
+8 IF $PIECE(X,"^",3)]""
WRITE !,"Hold Letter Comment: ",$PIECE(X,"^",3)
+9 IF $PIECE(X,"^")]""!($PIECE(X,"^",2)]"")!($PIECE(X,"^",3)]"")
WRITE !!,"NOTICE: 'HOLD LETTER' information deleted from bill",!!,"Please use the 'Suspend an AR Bill' option if you want this bill on 'hold'.",!
SET $PIECE(^PRCA(430,DA,1),"^",1,3)=""
+10 QUIT
End DoDot:1
GOTO HOLD
+11 SET DR="21;22;23"
SET DIE=DIC
DO ^DIE
GOTO HOLD
HEND KILL DA,DIC,DIE,DR
QUIT
RELHOLD ;=============== RELEASE HOLDING LETTER =============================
DIC NEW DPTNOFZY,DPTNOFZK
SET (DPTNOFZY,DPTNOFZK)=1
+1 SET DIC="^PRCA(430,"
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
GOTO REND
SET DA=+Y
ASK SET %=2
WRITE !!,"ARE YOU SURE YOU WANT TO REMOVE HOLD ON FOLLOW-UP FOR THIS ACCOUNT "
DO YN^DICN
IF %=0
DO YN^PRCAMESG
GOTO ASK
+1 if %'=1
GOTO REND
+2 KILL ^PRCA(430,DA,1)
WRITE *7,!!,"OK, THE HOLD HAS BEEN REMOVED !",!
GOTO RELHOLD
NOTH WRITE !," <NOTHING CHANGED> "
GOTO RELHOLD
REND KILL DIC,DA,%
QUIT
+1 ;
LISTHOL ;================= LIST OF HOLDING LETTERS ==========================
+1 SET DIC="^PRCA(430,"
SET BY="HOLD LETTER DATE,BILL NO."
SET FR=","
SET TO=","
SET L=0
SET DHD="LIST OF ACCOUNTS WITH HOLDS"
SET FLDS="[PRCA LIST HOLD]"
DO EN1^DIP
LEND KILL FLDS,L,FR,TO,DIC,DHD,BY
QUIT
