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

RCTOPU.m

Go to the documentation of this file.
  1. RCTOPU ;WASH IRMFO@ALTOONA,PA/TJK - TOP TRANSMISSION ;2/22/00 12:39 PM
  1. V ;;4.5;Accounts Receivable;**141,400**;Mar 20, 1995;Build 13
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified
  1. ;
  1. REPORT ;print top report
  1. N DIC,DIS,L,BY,FR,TO,FLDS,PG,PRINTOT,DIOEND
  1. W !!,"TOP REFERRAL REPORT",!!
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include Debtors At TOP With '0' Balance"
  1. S DIR("?")="Answering Yes will include those debtors referred whose current TOP balance is '0'."
  1. D ^DIR Q:(Y="")!(Y="^")
  1. S L=0,(FR,TO)="",DIC=340,BY=.01,FLDS="[RCTOP REPORT]",PRINTOT=0
  1. S DIS(0)="I $P($G(^RCD(340,D0,6)),U)"
  1. S:'Y DIS(0)=DIS(0)_",$P(^(4),U,3)"
  1. S DIOEND="D PRNTOT^RCTOPU"
  1. PRINT D EN1^DIP
  1. REPORTQ Q
  1. ;
  1. PRNTOT ;place total amount on report
  1. N DASH
  1. S DASH="",$P(DASH,"-",81)=""
  1. W !!,DASH
  1. W !,?6,"TOTAL AMOUNT CURRENTLY REFERRED:",?50,"$"_$J(PRINTOT,15,2)
  1. I $E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
  1. PRNTOTQ Q
  1. ;
  1. BILLREP ;prints individual bills and amounts that make up a TOP account
  1. N DIC,DEBTOR,ZTSAVE,ZTDESC,ZTRTN
  1. S DIC=340,DIC(0)="AEQM",DIC("S")="I $D(^RCD(340,""TOP"",+Y))" D ^DIC
  1. Q:Y<1 S DEBTOR=+Y
  1. S %ZIS="AEQ" D ^%ZIS G:POP BILLREPQ
  1. I $D(IO("Q")) D G BILLREPQ
  1. .S ZTSAVE("DEBTOR")=""
  1. .S ZTRTN="BILLREPP^RCTOPU",ZTDESC="TOP BILL REPORT"
  1. .D ^%ZTLOAD,^%ZISC
  1. .Q
  1. ;
  1. BILLREPP ;Call to build array of bills referred
  1. U IO
  1. N BILL,B14,B7,D4,FND,BAMT,TAMT,DIRUT,TNM,TID,TDT,DASH,CSTAT
  1. S DASH="",$P(DASH,"-",81)="",D4=$G(^RCD(340,DEBTOR,4))
  1. S TID=$S($P(D4,U,4)'="":$P(D4,U,4),1:$P(D4,U,1))
  1. S TNM=$S($P(D4,U,5)'="":$P(D4,U,5),1:$P(D4,U,2))
  1. S Y=$P(^RCD(340,DEBTOR,6),U,1) X ^DD("DD") S TDT=Y
  1. S TAMT=$P(D4,U,3) D BILLREPH
  1. S (FND,BILL)=0 F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:('BILL)!($D(DIRUT)) D
  1. .Q:'+$G(^PRCA(430,BILL,14))
  1. .S FND=1 W !,$P(^PRCA(430,BILL,0),U) S CSTAT=$P(^(0),U,8),B7=$G(^(7))
  1. .W ?14,$P(^PRCA(430.3,CSTAT,0),U,2)
  1. .S BAMT=0 F I=1:1:5 S BAMT=BAMT+$P(B7,U,I)
  1. .W ?20,$J(BAMT,10,2)
  1. .F I=1:1:5 W $J($P(B7,U,I),10,2)
  1. .;check for end of page here, if necessary form feed and print header
  1. .I $Y+3>IOSL D
  1. ..I $E(IOST,1,2)="C-" S DIR(0)="E" K DIRUT D ^DIR Q:$D(DIRUT)
  1. ..D BILLREPH
  1. .Q
  1. I $E(IOST,1,2)="C-" R !!,"END OF REPORT...PRESS RETURN TO CONTINUE",X:DTIME W @IOF
  1. D ^%ZISC
  1. BILLREPQ Q
  1. ;
  1. BILLREPH ;header for TOP bill report
  1. W @IOF
  1. W !,"DEBTOR: "_TNM
  1. W !,"TIN: "_TID," REFERRED TO TOP: "_TDT_" CURRENT TOP AMT: "_$J(TAMT,13,2)
  1. W !,DASH
  1. W !!,"BILL NO.",?14,"STAT",?27,"AMT",?36,"PRIN",?47,"INT",?55,"ADMIN",?65,"COURT",?72,"MARSHALL"
  1. W !,"---- ---",?14,"----",?27,"---",?36,"----",?47,"---",?55,"-----",?65,"-----",?72,"--------"
  1. Q
  1. ;
  1. STOP ;Stop TOP Referral on a Debtor
  1. N DIC,DIE,DA,DIR,Y,DEBTOR,REASON,COMMENT,EFFDT
  1. S DIC=340,DIC(0)="AEQM" D ^DIC Q:Y<0
  1. S DEBTOR=+Y
  1. I $P($G(^RCD(340,DEBTOR,6)),U,2) G DELSTOP
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure You Want To Stop TOP Referral For This Debtor" D ^DIR
  1. I 'Y W !,*7,"No Action Taken" Q
  1. ;
  1. REASON ;ask referral reason
  1. K DIR S DIR(0)="340,6.04" 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(0)="340,6.05" 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(^RCD(340,DEBTOR,6)),U,5)'="" S $P(^(6),U,5)=""
  1. ;
  1. I (REASON="N")!(REASON="R") D G STOPFILE
  1. .S $P(^RCD(340,DEBTOR,6),U)=""
  1. .K ^RCD(340,"TOP",DEBTOR)
  1. .S (EFFDT,REASON,COMMENT)=""
  1. .Q
  1. ;
  1. ;ask effective date (for 'waiver','banruptcy','other')
  1. ;
  1. S DIR(0)="340,6.03",DIR("A")="Enter Effective Date" D ^DIR S EFFDT=Y
  1. ;
  1. STOPFILE ;set stop referral data in file 340
  1. S $P(^RCD(340,DEBTOR,6),U,2,5)="1^"_EFFDT_U_REASON_U_$G(COMMENT)
  1. ;
  1. W !,"Stop TOP Referral Complete"
  1. G STOPQ
  1. ;
  1. DELSTOP ;Allows TOP Referral to be re-instituted for debtor
  1. W !!,*7,"Referral to TOP has already been stopped for this debtor"
  1. S DIR(0)="Y",DIR("A")="Do You Wish To Re-Institute TOP Referral for this Debtor",DIR("B")="NO" D ^DIR G EDSTOP:'Y
  1. ;
  1. ;reset file to allow top referral to be re-started
  1. F I=2:1:5 S $P(^RCD(340,DEBTOR,6),U,I)=""
  1. W !!,"Debtor Is Now Eligible To Be Referred To TOP" G STOPQ
  1. ;
  1. EDSTOP S DIR(0)="Y",DIR("A")="Do You Wish To Edit The Stop Referral Data For This Debtor",DIR("B")="NO" D ^DIR G REASON:Y
  1. STOPQ Q
  1. ;
  1. REVERSE ;Refund Reversal
  1. N DEBTOR,DIC,DIE,DR,BILL,TRACE,REFYR
  1. W !!,"Refund Reversal Of TOP Refund"
  1. S DIC=430,DIC(0)="AEQLMZ",DIC("S")="I $D(^PRCA(430,""TREF"",2,+Y))"
  1. S DIC("A")="Enter Refund Bill To Be Reversed:" D ^DIC Q:Y<0
  1. S DEBTOR=$P(Y(0),U,9),BILL=+Y
  1. I 'DEBTOR W !!,*7,"No Debtor Attached To This Bill." Q
  1. S TRACE=$P($G(^RCD(340,DEBTOR,6)),U,7),REFYR=$P($G(^PRCA(430,BILL,14)),U,4)
  1. I 'TRACE W !!,*7,"There is no current TOP Trace Number for this debtor",!,"This should have been entered with the most recent TOP payment" Q
  1. I 'REFYR W !!,*7,"There is no TOP Refund Year Entered for this bill",!,"This should have been entered when the refund was approved." Q
  1. S DIR(0)="Y",DIR("A")="Are You Sure You Wish To Reverse This Refund"
  1. S DIR("B")="NO" D ^DIR I 'Y W !!,"No Action Taken" Q
  1. S DIE="^PRCA(430,",DA=BILL,DR="142///3;143///^S X=TRACE" D ^DIE
  1. W !,"Reversal Will Be Transmitted With Next TOP Transmission"
  1. REVERSEQ Q
  1. ;
  1. UPDCODE ;Update Refund/Reversal Codes in File 348.2
  1. W !,"TOP Refund/Refund Reversal Code Entry"
  1. S DIC=348.2,DIC(0)="AEQML" D ^DIC
  1. UPDCODEQ Q
  1. ;
  1. STOPREF(DEBTOR,REASON,CMNT,EFDT) ; stop TOP referral for a given debtor (no user interaction) PRCA*4.5*400
  1. ;
  1. ; DEBTOR - file 340 ien
  1. ; REASON - stop referral reason, field 340/6.04 (internal)
  1. ; CMNT - stop referral comment, field 340/6.05
  1. ; EFDT - effective date, field 340/6.03 (internal)
  1. ;
  1. ; returns 1 on success, 0^[error message] otherwise
  1. ;
  1. N DIERR,FDA,IENS,N6
  1. I '$D(^RCD(340,DEBTOR,0)) Q "0^Invalid file 340 ien" ; invalid ien
  1. S N6=$G(^RCD(340,DEBTOR,6))
  1. I +$P(N6,U)'>0 Q "0^no TOP referral" ; no referral date
  1. I $P(N6,U,2) Q "0^referral already stopped" ; referral already stopped
  1. S CMNT=$G(CMNT) I REASON="O",CMNT="" Q "0^comment is required" ; "Other" reason requires comment
  1. S IENS=DEBTOR_","
  1. S FDA(340,IENS,6.02)=1
  1. I (REASON="N")!(REASON="R") S FDA(340,IENS,6.01)="",(EFDT,REASON,CMNT)=""
  1. S FDA(340,IENS,6.03)=EFDT
  1. S FDA(340,IENS,6.04)=REASON
  1. S FDA(340,IENS,6.05)=CMNT
  1. L +^RCD(340,DEBTOR):5 I '$T Q "0^Unable to lock file 340 entry"
  1. D FILE^DIE("","FDA","DIERR")
  1. L -^RCD(340,DEBTOR)
  1. I $D(DIERR("DIERR")) Q "0^"_$G(DIERR("DIERR",1,"TEXT",1))
  1. Q 1