Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCTCSPU

RCTCSPU.m

Go to the documentation of this file.
  1. RCTCSPU ;ALBANY/BDB - CROSS-SERVICING UTILITIES ;03/15/14 3:34 PM
  1. ;;4.5;Accounts Receivable;**301,315,350,400**;Mar 20, 1995;Build 13
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;total amount of bills for a debtor
  1. TOTALB(DEBTOR) ;
  1. N TOTAL,BILL,B7
  1. S TOTAL=0,BILL=0
  1. F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
  1. .Q:'$D(^PRCA(430,"TCSP",BILL))
  1. .S B7=$G(^PRCA(430,BILL,7))
  1. .S TOTAL=TOTAL+$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
  1. Q TOTAL
  1. ;
  1. ;stop TCSP referral on a bill
  1. STOP ;stop Cross-Servicing referral
  1. N DIC,DIE,DA,DR,DIR,Y,BILL,REASON,COMMENT,EFFDT
  1. I $G(GOTBILL) S BILL=RCBILLDA ;PRCA*4.5*315
  1. I '$G(GOTBILL) S DIC=430,DIC(0)="AEQM" D ^DIC Q:Y<0 ;PRCA*4.5*315
  1. I '$G(GOTBILL) S BILL=+Y ;PRCA*4.5*315
  1. I $P($G(^PRCA(430,BILL,15)),U,7) G DELSTOP
  1. W !,"Stop flag for Cross-Servicing Referral set? : NO"
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to stop the Cross-Servicing Referral for this bill" D ^DIR
  1. I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 ; account profile listman quit flag *315
  1. I 'Y W !,*7,"No action taken" Q
  1. ;
  1. REASON ;ask referral reason
  1. K DIR S DIR("A")="Enter Stop Cross-Servicing Reason ",DA=BILL,DIR(0)="430,159" D ^DIR
  1. Q:(Y="")!(Y=U)
  1. S REASON=Y I REASON="O" D Q:COMMENT=U G REASON:COMMENT=""
  1. .S COMMENT="",DIR("A")="Enter Stop Reason Comment ",DA=BILL,DIR(0)="430,159.1" D ^DIR S COMMENT=Y
  1. .I COMMENT="" W !,"A Reason of Other requires a comment to be entered"
  1. .Q
  1. I REASON'="O",$P($G(^PRCA(430,BILL,15)),U,10)'="" S $P(^(15),U,10)=""
  1. ;
  1. ;ask effective date
  1. ;
  1. S DIR(0)="430,158",DA=BILL,DIR("A")="Enter Effective Date " D ^DIR G:Y=U STOPQ S EFFDT=Y
  1. ;
  1. STOPFILE ;set stop referral data in file 430
  1. S $P(^PRCA(430,BILL,15),U,7,10)="1^"_EFFDT_U_REASON_U_$G(COMMENT)
  1. ;
  1. W !,"Stop Cross-Servicing Referral complete"
  1. D STOP^RCTCSPD4 ; *315 Create CS Stop Placed comment tx in 433
  1. G STOPQ
  1. ;
  1. DELSTOP ;Allows Cross-Servicing Referral to be re-instituted for bill
  1. N I
  1. W !!,*7,"Referral to Cross-Servicing has already been stopped for this bill."
  1. W !,"Stop Cross-Servicing referral effective date: ",$$GET1^DIQ(430,BILL,158,"E")
  1. W !,"Stop Cross-Servicing referral reason : ",$$GET1^DIQ(430,BILL,159,"E")
  1. I $$GET1^DIQ(430,BILL,159,"E")="OTHER" W !,"Stop Cross-Servicing referral comment : ",$$GET1^DIQ(430,BILL,159.1,"E")
  1. S DIR(0)="Y",DIR("A")="Do you wish to re-institute Cross-Servicing Referral for this bill",DIR("B")="NO"
  1. D ^DIR
  1. I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 G STOPQ ; account profile listman quit flag *315
  1. G EDSTOP:'Y
  1. ;
  1. ;reset file to allow cross-servicing referral to be re-started
  1. F I=7:1:10 S $P(^PRCA(430,BILL,15),U,I)=""
  1. W !!,"Bill is now eligible to be Referred to Cross-Servicing" D DELSTOP^RCTCSPD4 G STOPQ ; *315 create CS Stop Deleted transaction
  1. ;
  1. EDSTOP S DIR(0)="Y",DIR("A")="Do you wish to edit the Stop Referral Data for this bill",DIR("B")="NO" D ^DIR G REASON:Y
  1. STOPQ Q
  1. ;
  1. ;Set Cross-Servicing recall for a bill
  1. RCLLSETB ;Set Cross-Servicing recall
  1. N DIC,DIE,DA,DR,DIR,Y,BILL,REASON
  1. I '$G(GOTBILL) S DIC=430,DIC(0)="AEQM" D ^DIC Q:Y<0
  1. I '$G(GOTBILL) S BILL=+Y
  1. I $G(GOTBILL) S BILL=RCBILLDA
  1. I $P($G(^PRCA(430,BILL,15)),U,2) G DELSETB
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to set this bill to be recalled from Cross-Servicing" D ^DIR
  1. I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 ; account profile listman quit flag *315
  1. I 'Y W !,*7,"No action taken" Q
  1. I '$D(^PRCA(430,"TCSP",BILL)) W !,*7,"No action taken. Bill has not been referred to Cross-Servicing." Q
  1. ;
  1. RCRSB ;ask recall reason
  1. K DIR S DIR(0)="S^01:DEBT REFERRED IN ERROR;07:AGENCY IS FORGIVING DEBT;08:AGENCY CAN COLLECT THROUGH INTERNAL OFFSET" D ^DIR
  1. Q:(Y="")!(Y=U)
  1. ;set recall data in file 430
  1. S REASON=Y
  1. S $P(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
  1. D CSRCLPL^RCTCSPD5 ; *315 CS Recall Placed comment tx in 433
  1. W !,"Setting this bill for Recall from Cross-Servicing is complete"
  1. G SETBQ
  1. ;
  1. RRSET ; Set rerefer for bills PRCA*4.5*350
  1. N BILL,STOP
  1. S STOP=0
  1. F D RRSETB Q:BILL="" Q:STOP
  1. Q
  1. ; Set rerefer for bill PRCA*4.5*350
  1. RRSETB ;
  1. N DIC,DIE,DA,DR,DIR,Y,DIROUT,DTOUT,DUOUT,DIRUT
  1. N WR,EXE,DEBTOR,CHECK,REASON,COMMENT,LIEN,QUIT,FIXABLE
  1. S BILL="",LIEN="",QUIT=""
  1. ; Still experimenting if to use DIC or DIR
  1. S DIC=430,DIC(0)="AEQMS",DIC("A")="Enter Bill Number for re-referral: "
  1. ; we will allow selection of bills here and show error message if we don't like bill.
  1. ;S DIC("S")="I $D(^PRCA(430,Y,15))"
  1. D ^DIC
  1. S BILL=+Y S:Y=-1 STOP=1
  1. I STOP Q
  1. S DEBTOR=$P($G(^PRCA(430,BILL,0)),U,9)
  1. I $$RR^RCTCSPU(BILL)=0 D Q:STOP Q:QUIT
  1. . N NZ,REASON,COMMENT
  1. . W !!,"Re-Referral has already been requested",!
  1. . S LIEN=$O(^PRCA(430,BILL,15.5,99999),-1)
  1. . S NZ=^PRCA(430,BILL,15.5,LIEN,0),REASON=$P(NZ,U,4),COMMENT=$P(NZ,U,5)
  1. . W !,"By ",$P(^VA(200,$P(NZ,U,3),0),U)," on ",$$FMTE^XLFDT($P(NZ,U,2),"5Z")," Reason: "
  1. . W $S(REASON="R":"Recall in error",REASON="T":"Treasury reversal",REASON="D":"Defaulted RPP",REASON="O":"Other: "_COMMENT,1:""),!
  1. . K DIR S DIR("A")="Do you want to Cancel this Re-Referral",DIR("B")="NO",DIR(0)="Y" D ^DIR
  1. . I X="" S STOP=1 Q
  1. . I $G(DTOUT) S STOP=1 Q
  1. . I $G(DIROUT) S STOP=1 Q
  1. . I $G(DUOUT) S STOP=1 Q
  1. . I Y D S QUIT=1 Q
  1. . . ; remove LIEN from 15.5. Use DIK?
  1. . . I LIEN=1 K ^PRCA(430,BILL,15.5,0)
  1. . . E S $P(^PRCA(430,BILL,15.5,0),U,2)=430.03,$P(^PRCA(430,BILL,15.5,0),U,3)=LIEN-1,$P(^PRCA(430,BILL,15.5,0),U,4)=$P(^PRCA(430,BILL,15.5,0),U,4)-1
  1. . . K ^PRCA(430,BILL,15.5,LIEN)
  1. . . K ^PRCA(430,BILL,15.5,"B",0,LIEN)
  1. . . D RRCAN^RCTCSPD4
  1. . . W !!,"*** Re-Referral has been cancelled for this bill ***"
  1. . . Q
  1. . K DIR S DIR("A")="Do you want to Update this Re-Referral",DIR("B")="NO",DIR(0)="Y" D ^DIR
  1. . I X="" S QUIT=1 Q
  1. . I $G(DTOUT) S STOP=1 Q
  1. . I $G(DIROUT) S STOP=1 Q
  1. . I $G(DUOUT) S STOP=1 Q
  1. . I X?1"N".E!(X?1"n".E) W !!,"*** No changes applied to this re-referral ***",! S QUIT=1 Q
  1. D
  1. . S CHECK=1
  1. . I 'DEBTOR S CHECK="0^0^Bill has no debtor" Q
  1. . I '$P($G(^PRCA(430,BILL,30)),U),'$P($G(^PRCA(430,BILL,15)),U,3) S CHECK="0^0^Bill is not Returned or Recalled, so can't re-refer" Q
  1. . ; Disabling Stop flag is OK for now, but we will need to clear it at some point. Batch Job?
  1. . S CHECK=$$RSBILCHK^RCTCSPD0(BILL,"3,20")
  1. I 'CHECK D Q
  1. . S FIXABLE=$F(",0,3,5,6,12,15,16,19,20,21,24,26,27,",","_$P(CHECK,U,2)_",")
  1. . I 'FIXABLE W !!,"Unable to complete the re-referral process",!,$P(CHECK,U,3) Q
  1. . W !!,"This bill has issues and will not make it through re-referral process because:",!,$P(CHECK,U,3)
  1. . W !!,"PLEASE CORRECT THIS ISSUE AND THEN RE-REFER THE BILL AGAIN",!
  1. . K DIR S DIR(0)="FO",DIR("A")="Press <ENTER> to continue " D ^DIR
  1. . I (Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1
  1. ; Ask Rerefer Reason and description if O=Other
  1. K DIR S DIR(0)="S^R:Recall in error;T:Treasury reversal;D:Defaulted RPP;O:Other"
  1. S DIR("A")="Select Reason for this re-referral"
  1. D ^DIR
  1. I (Y="")!(Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1 Q
  1. W !
  1. S REASON=Y
  1. I REASON="O" K DIR S DIR(0)="F^1:30",DIR("A")="Enter ""Other"" description " D ^DIR Q:Y="" Q:Y=U S COMMENT=Y
  1. ; Are you sure (do we want to ask this for update to rereferral?)
  1. K DIR S DIR("A")="Are you sure you want to Re-refer this bill for Cross-Servicing",DIR(0)="Y",DIR("B")="YES"
  1. D ^DIR
  1. I (Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1 Q
  1. I 'Y W !!,"*** No updates applied ***" Q
  1. ; user, date, status of rerefer
  1. I LIEN'="" D
  1. . ; That should be all we need for update of last IEN
  1. . S ^PRCA(430,BILL,15.5,LIEN,0)=0_U_DT_U_DUZ_U_REASON_U_$G(COMMENT)
  1. I LIEN="" D
  1. . S LIEN=$O(^PRCA(430,BILL,15.5,99999),-1)+1
  1. . S $P(^PRCA(430,BILL,15.5,0),U,2)=430.03
  1. . S $P(^PRCA(430,BILL,15.5,0),U,3)=LIEN
  1. . S $P(^PRCA(430,BILL,15.5,0),U,4)=$P(^PRCA(430,BILL,15.5,0),U,4)+1
  1. . S ^PRCA(430,BILL,15.5,LIEN,0)=0_U_DT_U_DUZ_U_REASON_U_$G(COMMENT)
  1. . S ^PRCA(430,BILL,15.5,"B",0,LIEN)=""
  1. W !!,"Bill is set to be re-referred to Cross-Servicing in the next weekly transmission"
  1. W !
  1. ; file Rerefer Request transaction
  1. D RRREQ^RCTCSPD4
  1. K DIR S DIR(0)="FO",DIR("A")="Press <ENTER> to continue " D ^DIR
  1. W !
  1. I (Y=U)!$G(DTOUT)!$G(DUOUT) S STOP=1 Q
  1. Q
  1. RR(BILL) ; PRCA*4.5*350
  1. ; Return: Null = no RR, 0 = RR Requested, 1 = RR Performed
  1. N LIEN
  1. Q:BILL="" ""
  1. S LIEN=$O(^PRCA(430,BILL,15.5,99999),-1)
  1. I LIEN<1 Q ""
  1. Q $P(^PRCA(430,BILL,15.5,LIEN,0),U)
  1. ;
  1. RRD(DEBTOR) ; PRCA*4.5*350
  1. ; Return: 0 = Debtor has no RR bills, 1 = Debtor has RR bills
  1. Q:DEBTOR="" 0
  1. N BILL,OUT
  1. S BILL="",OUT=0
  1. F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL="" I $$RR(BILL) S OUT=1 Q
  1. Q OUT
  1. ;
  1. DELSETB ;Allows Cross-Servicing Recall to be deleted for bill
  1. W !!,*7,"This bill has already been set for recall from Cross-Servicing."
  1. I +$P($G(^PRCA(430,BILL,15)),U,3) W !!,"Not available for reactivation. The Recall request has already been processed." G SETBQ
  1. S DIR(0)="Y",DIR("A")="Do you wish to delete the Cross-Servicing Recall for this bill",DIR("B")="NO"
  1. D ^DIR
  1. I $G(GOTBILL),$D(DIRUT) S RCDPGQ=1 G SETBQ ; account profile listman quit flag *315
  1. G EDSETB:'Y
  1. ;
  1. ;delete the recall
  1. F I=2:1:5 S $P(^PRCA(430,BILL,15),U,I)=""
  1. D DELRCLL^RCTCSPD4 ; *315 Create CS Delete Recall comment tx in 433
  1. W !!,"Recall from Cross-Servicing has been deleted for this bill."
  1. G SETBQ
  1. ;
  1. EDSETB S DIR(0)="Y",DIR("A")="Do you wish to edit the Recall data for this bill",DIR("B")="NO" D ^DIR G RCRSB:Y
  1. SETBQ Q
  1. ;
  1. ;Set Cross-Servicing recall for a debtor
  1. RCLLSETD ;Set Cross-Servicing debtor recall
  1. N DIC,DIE,DA,DR,DIR,Y,DEBTOR,REASON,BILL
  1. ; GOTDEBT, RCDEBTDA - are defined if called from List Manager
  1. I '$G(GOTDEBT) S DIC=340,DIC(0)="AEQM" D ^DIC Q:Y<0 ; *315
  1. I '$G(GOTDEBT) S DEBTOR=+Y ; *315
  1. I $G(GOTDEBT) S DEBTOR=RCDEBTDA ; *315
  1. I $P($G(^RCD(340,DEBTOR,7)),U,2),'$P($G(^RCD(340,DEBTOR,7)),U,3) G DELSETD
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to recall this debtor and bills from Cross-Servicing" D ^DIR
  1. I 'Y W !,*7,"No action taken" Q
  1. I '$D(^RCD(340,"TCSP",DEBTOR)) W !,*7,"No action taken. Debtor has not been referred to Cross-Servicing." Q
  1. ;
  1. RCRSD ;ask debtor recall reason
  1. K DIR S DIR(0)="340,7.04" D ^DIR
  1. Q:(Y="")!(Y=U)
  1. ;set debtor recall data in file 340
  1. S REASON=Y
  1. ;S $P(^RCD(340,DEBTOR,7),U,2,4)="1^^"_REASON PRCA*4.5*400
  1. ;go through debtor bills and set reason in the bill recall reason
  1. S BILL=0
  1. F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
  1. .I $D(^PRCA(430,"TCSP",BILL)) D Q ;bill previously sent to TCSP
  1. ..S $P(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON ;set the recall flag and reason (TV9)
  1. ..D CSRCLPL^RCTCSPD5 ; *315 Create CS RECALL PLACED tx in 433
  1. W !,"Setting this debtor for Recall from Cross-Servicing is complete"
  1. G SETDQ
  1. ;
  1. DELSETD ;Allows Cross-Servicing Recall to be deleted for debtor
  1. W !!,*7,"This debtor has already been set for recall from Cross-Servicing."
  1. S DIR(0)="Y",DIR("A")="Do you wish to delete the Cross-Servicing Recall for this debtor",DIR("B")="NO" D ^DIR G EDSETD:'Y
  1. ;
  1. ;delete the recall in file 340
  1. F I=2:1:4 S $P(^RCD(340,DEBTOR,7),U,I)=""
  1. ;go through debtor bills and delete the recall flag & reason
  1. S BILL=0
  1. F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
  1. .I $D(^PRCA(430,"TCSP",BILL)) D Q ;bill previously sent to TCSP
  1. ..S $P(^PRCA(430,BILL,15),U,2)="" ; delete the recall flag PRCA*4.5*315
  1. ..S $P(^PRCA(430,BILL,15),U,4)="" ; delete the recall reason
  1. ..D DELRCLL^RCTCSPD4 ; *315 CS DEL BILL RECALL in 433
  1. ;
  1. W !!,"Recall from Cross-Servicing has been deleted for this debtor."
  1. G SETDQ
  1. ;
  1. EDSETD S DIR(0)="Y",DIR("A")="Do you wish to edit the Recall data for this debtor",DIR("B")="NO" D ^DIR G RCRSD:Y
  1. SETDQ Q
  1. ;
  1. DECADJ(RCBILLDA,RCTRANDA) ;decrease adjustment transaction history for 5b cross-servicing record
  1. ;rcbillda - file 430 bill ien
  1. ;rctranda - file 433 transaction ien
  1. N BILL,DIC,DA,DIE,DR,Y,X
  1. I '$D(RCBILLDA)!('$D(RCTRANDA)) Q
  1. S X=RCTRANDA
  1. S DIC="^PRCA(430,"_RCBILLDA_",17,",DIC(0)="L"
  1. I '$D(^PRCA(430,RCBILLDA,17,0)) S ^PRCA(430,RCBILLDA,17,0)="^430.0171PA^0^0"
  1. S DIC("P")=$P(^PRCA(430,RCBILLDA,17,0),"^",2)
  1. S DA(1)=RCBILLDA
  1. S BILL=RCBILLDA
  1. D ^DIC I Y=-1 K DIC,DA Q
  1. S DIE=DIC K DIC
  1. S DA=+Y
  1. S DR="1////1" D ^DIE ; Reinstated the 4 slashes
  1. Q
  1. ;
  1. INCADJ(RCBILLDA,RCTRANDA) ;increase adjustment transaction history for 5b cross-servicing record 315/DRF
  1. ;rcbillda - file 430 bill ien
  1. ;rctranda - file 433 transaction ien
  1. N DIC,DA,DIE,DR,Y,X
  1. I '$D(RCBILLDA)!('$D(RCTRANDA)) Q
  1. S X=RCTRANDA
  1. S DIC="^PRCA(430,"_RCBILLDA_",17,",DIC(0)="L"
  1. I '$D(^PRCA(430,RCBILLDA,17,0)) S ^PRCA(430,RCBILLDA,17,0)="^430.0171PA^0^0"
  1. S DIC("P")=$P(^PRCA(430,RCBILLDA,17,0),"^",2)
  1. S DA(1)=RCBILLDA
  1. D ^DIC I Y=-1 K DIC,DA Q
  1. S DIE=DIC K DIC
  1. S DA=+Y
  1. S DR="1////1" D ^DIE
  1. Q
  1. ;
  1. RCLLSETC ;Set Cross-Servicing recall for a case
  1. N DIC,DIE,DA,DR,DIR,Y,BILL,REASON
  1. S DIC=430,DIC(0)="AEQM" D ^DIC Q:Y<0
  1. S BILL=+Y
  1. I $P($G(^PRCA(430,BILL,15)),U,11) G DELSETC
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to set this case to be recalled from Cross-Servicing" D ^DIR
  1. I 'Y W !,*7,"No action taken" Q
  1. I '$D(^PRCA(430,"TCSP",BILL)) W !,*7,"No action taken. Case has not been referred to Cross-Servicing." Q
  1. ;
  1. RCRSC ;set case recall reason
  1. ;set recall data in file 430 for the bill and the case
  1. S REASON=15
  1. S $P(^PRCA(430,BILL,15),U,11,13)="1^^"_REASON
  1. S $P(^PRCA(430,BILL,15),U,2,4)="1^^"_REASON
  1. ;
  1. D RCRSC^RCTCSPD4 ; *315 CS CASE RECALL tx
  1. W !,"Setting this case for Recall from Cross-Servicing is complete"
  1. G SETCQ
  1. ;
  1. DELSETC ;Allows Cross-Servicing Recall to be deleted for case
  1. W !!,*7,"This case has already been set for recall from Cross-Servicing."
  1. S DIR(0)="Y",DIR("A")="Do you wish to delete the Cross-Servicing Recall for this case",DIR("B")="NO" D ^DIR G SETCQ:'Y
  1. ;
  1. ;delete the case recall
  1. F I=11:1:13 S $P(^PRCA(430,BILL,15),U,I)=""
  1. F I=2:1:5 S $P(^PRCA(430,BILL,15),U,I)=""
  1. D DELSETC^RCTCSPD4 ; *315 Create CS Delete Case Recall comment tx in 433
  1. W !!,"Recall from Cross-Servicing has been deleted for this case."
  1. G SETCQ
  1. ;
  1. SETCQ Q
  1. ;
  1. SSN(DEBT) ;Get SSN for debtor
  1. ;Input Debtor (340)
  1. ;Output: SSN # or null
  1. NEW Y
  1. S Y=-1 G:'$G(DEBT) Q1
  1. S:DEBT?1N.N DEBT=$P($G(^RCD(340,DEBT,0)),"^")
  1. I DEBT[";DPT(" S Y=$P($G(^DPT(+DEBT,0)),"^",9)
  1. I DEBT[";VA(200," S Y=$P($G(^VA(200,+DEBT,1)),"^",9)
  1. Q1 Q Y
  1. ;
  1. Q
  1. ;
  1. RECALL(BILL) ; recall bill from cross-servicing due to HRFS flag being set PRCA*4.5*400
  1. ;
  1. ; BILL - bill to recall (file 430 ien)
  1. ;
  1. ; returns 1 on success, 0^error on failure
  1. ;
  1. N DIERR,FDA,IENS
  1. I BILL'>0 Q "0^Invalid file 430 ien"
  1. L +^PRCA(430,BILL):5 I '$T Q "0^Unable to lock entry"
  1. S IENS=BILL_","
  1. S FDA(430,IENS,152)=1
  1. S FDA(430,IENS,154)="05"
  1. D FILE^DIE("","FDA","DIERR")
  1. I $D(DIERR("DIERR")) Q "0^"_$G(DIERR("DIERR",1,"TEXT",1))
  1. L -^PRCA(430,BILL)
  1. D CSRCLPL1^RCTCSPD5 ; CS Recall Placed comment tx in 433
  1. Q 1