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

RCDPRPL4.m

Go to the documentation of this file.
  1. RCDPRPL4 ;WISC/RFJ/PJH-receipt profile listmanager options ;1 Apr 01
  1. ;;4.5;Accounts Receivable;**169,172,173,269,276,326,332**;Mar 20, 1995;Build 40
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ; this routine contains the entry points for receipt management
  1. ;
  1. ;
  1. ONLINE ; allow the supervisor to mark the CR document as input on line
  1. ;
  1. ; Input - RCRECDA - IEN of CR receipt in #344
  1. ;
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. ; get fms document and status
  1. N %,FMSDOC,GECSDATA
  1. S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
  1. ;
  1. W !!,"This option will allow you to mark a rejected Cash Receipt document as"
  1. W !,"entered on line. This will prevent the document from being listed on"
  1. W !,"the nightly mailman message used to help manage the receipts and deposits."
  1. ;
  1. W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
  1. ;
  1. I '$D(^XUSEC("PRCAY PAYMENT SUP",DUZ)) W !!,"You are not an owner of the supervisor PRCAY PAYMENT SUP security key." D QUIT Q
  1. ;
  1. ; cr accepted
  1. I $E($P(FMSDOC,"^",2))="A" W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is ACCEPTED ??" D QUIT Q
  1. ;
  1. ; not been transmitted for 2 days
  1. I $E($P(FMSDOC,"^",2))="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))'>2 W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document has NOT been TRANSMITTED for 2 days ??" D QUIT Q
  1. ;
  1. ; cr queued for transmission
  1. I $E($P(FMSDOC,"^",2))="Q"!($E($P(FMSDOC,"^",2))="M") W !!,"You CANNOT mark the Cash Receipt document as entered on line.",!,"The CR document is waiting to be TRANSMITTED ??" D QUIT Q
  1. ;
  1. ; check to see if already marked as entered on line
  1. I $E($P(FMSDOC,"^",2))="O" D Q
  1. . I $$ASKSTAT("REMOVE")'=1 Q
  1. . W !,"... removing CR status as entered on line ..."
  1. . ; remove the ON-LINE status on field 201
  1. . D EDITREC^RCDPUREC(RCRECTDA,"201///0")
  1. . ; show the new status
  1. . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
  1. . W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
  1. . D QUIT
  1. ;
  1. ; ask to change the status to entered on line
  1. I $$ASKSTAT("ENTER")'=1 D QUIT Q
  1. ;
  1. ; change the status to entered on line
  1. W !!,"... changing status to entered on line ..."
  1. W !,"... changing the generic code sheet stack file status to ACCEPTED ..."
  1. ;
  1. ; set the status to entered on line in field 201
  1. D EDITREC^RCDPUREC(RCRECTDA,"201///1")
  1. ;
  1. ; set the generic code sheet status as accepted
  1. ; get the document ien
  1. D DATA^GECSSGET($P(FMSDOC,"^"))
  1. I $G(GECSDATA) D SETSTAT^GECSSTAA(GECSDATA,"A")
  1. ;
  1. ; show the new status
  1. S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
  1. W !!,"FMS Cash Receipt Document: ",$P(FMSDOC,"^"),?48,"Status: ",$P(FMSDOC,"^",2)
  1. ;
  1. QUIT ; pause and rebuild the header
  1. W !!,"press RETURN to continue: "
  1. R %:DTIME
  1. D HDR^RCDPRPLM
  1. Q
  1. ;
  1. ;
  1. ASKSTAT(ACTION) ; ask if its okay to remove or change the entered online status
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A",1)=" Do you want to "_ACTION_" the status showing the Cash Receipt"
  1. S DIR("A")=" document was entered ON LINE"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ERAWL(RCSCR) ; Generate automatic dec adj from ERA Worklist in RCSCR
  1. ; RCADJ returned = 1 if passed by reference and adjustment successful
  1. ; returned = 2 if passed by ref and adjustments aborted
  1. ; returned = -1 if error
  1. ; returned = 0 if no WL adjustments found
  1. N RCZ,RCZ0,Z00,V00,RCCOM,RC1,RCADJ,RCOK,WLA
  1. S RC1=1,RCZ=0,RCADJ=0
  1. F S RCZ=$O(^RCY(344.49,RCSCR,1,RCZ)) Q:'RCZ!(RCADJ=2) S V00=$G(^(RCZ,0)),RCZ0=0 F S RCZ0=$O(^RCY(344.49,RCSCR,1,RCZ,1,RCZ0)) Q:'RCZ0!(RCADJ=2) S Z00=$G(^(RCZ0,0)) Q:"12"'[+$P(Z00,U,5) D
  1. . S RCCOM(1)=$P(Z00,U,9)
  1. . I RC1,$P(Z00,U,5)=1 D Q:RCADJ=2
  1. .. S RC1=0
  1. .. S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="Generating automatic decrease adjustments from EDI Lbox Worklist ...",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
  1. .. D ^DIR K DIR
  1. .. I Y'=1 S RCADJ=2
  1. . I $P(Z00,U,8)=1 D Q ; previously done
  1. .. I $P(Z00,U,5)=1 W !," Automatic decrease adj from ERA Worklist for bill #"_$P($G(^PRCA(430,+$P(V00,U,7),0)),U),!," for amount of "_$J(+$P(Z00,U,3),"",2)_" was previously completed" S RCADJ=1
  1. . I $P(Z00,U,5)=1 D Q ; Decrease adj
  1. .. S WLA=$$INCDEC^RCBEUTR1($P(V00,U,7),$P(Z00,U,3),.RCCOM,,,1) I 'WLA D
  1. ... ; PRCA276 - $$INCDEC can now return "0^1" which means a negative claim balance could have occurred if the decrease adjustment was applied to the claim
  1. ... S RCADJ=-1 W !," Could not perform automatic decrease adj from ERA Worklist for ",!," bill # "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_" for amount of "_$J(+$P(Z00,U,3),"",2)
  1. ... I $P(WLA,U,2) D
  1. .... S RCADJ=2
  1. .... W !,"WARNING: Receipt cannot be processed.",!,"Processing this receipt will cause this bill to have a negative balance",!,"which is outside the scope of VA Accounting regulations."
  1. .... W !,"Correct the error and reprocess this receipt."
  1. .. E D ; success
  1. ... D UPD(RCSCR,RCZ,RCZ0)
  1. ... S RCADJ=1
  1. ... W !," EDI Lbox Worklist automatic dec adjustment made to "_$P($G(^PRCA(430,+$P(V00,U,7),0)),U)_": "_$J(+$P(Z00,U,3),"",2)
  1. . I $P(Z00,U,5)=2 D Q ; Bill comment
  1. .. D ADDCOMM^RCBEUTRA($P(V00,U,7),.RCCOM),UPD(RCSCR,RCZ,RCZ0)
  1. ;
  1. Q $G(RCADJ)
  1. ;
  1. UPD(RCSCR,Z,Z0) ; Mark as complete so it doesn't get done twice
  1. N DA,DIE,DR
  1. S DA(2)=RCSCR,DA(1)=Z,DA=Z0
  1. S DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,",DR=".08////1" D ^DIE
  1. Q
  1. ;