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

RCDPEWL8.m

Go to the documentation of this file.
  1. RCDPEWL8 ;ALB/TMK/PJH - EDI LOCKBOX WORKLIST ERA LEVEL ;Jun 06, 2014@19:11:19
  1. ;;4.5;Accounts Receivable;**208,269,276,298,304,318,321,326**;Mar 20, 1995;Build 26
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. FILESP ; Action that files the split lines
  1. ; Assumes RCDIR,RCLINE,RCSCR,RCSPLIT array defined
  1. N RCTOT,Z,RCZ0,RCZ1,DTOUT,DUOUT,DIR,X,Y,DIE,DA,DR,DIC,DD,DO,DLAYGO,RCZ,RCZZ,RCZT,VALBCK
  1. D FULL^VALM1
  1. I '$G(^TMP("RCDPE_EOB_SPLIT_OK",$J)) D Q
  1. . S VALMBCK="R"
  1. . F Z=2,3 S RCTOT(Z)=$$TOT^RCDPEWL3(Z,.RCSPLIT)
  1. . S DIR(0)="EA"
  1. . S DIR("A",1)="TOTAL "_$S(+RCTOT(2)'=+$P(RCDIR,U,2):"PAYMENTS",1:"ADJUSTMENTS")_$S(+RCTOT(3)=+$P(RCDIR,U,3):"",+RCTOT(2)'=+$P(RCDIR,U,2):" AND ADJUSTMENTS",1:"")_" DO NOT MATCH THE ORIGINAL AMOUNT(s):"
  1. . S DIR("A",2)=$E(" ORIG PAY AMT: "_$J(+$P(RCDIR,U,2),"",2)_$J("",35),1,35)_" ORIG ADJ AMT: "_$J(+$P(RCDIR,U,3),"",2)
  1. . S DIR("A",3)=$E(" AMT ENTERED: "_$J(+RCTOT(2),"",2)_$J("",35),1,35)_" AMT ENTERED: "_$J(+RCTOT(3),"",2)
  1. . S DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
  1. S DA(1)=RCSCR
  1. S RCZ0=+$P(RCLINE,U,2),RCZZ=+$G(^RCY(344.49,DA(1),1,RCZ0,0)),RCZZ(1)=""
  1. S RCZ=+$O(RCSPLIT(0))
  1. ;
  1. ;Option to move/copy EOB
  1. I RCZ D Q:$G(VALMBCK)="Q"
  1. .;;Move/Copy removed 10/19/11-now in receipt creation +136^RCDPEM
  1. .;;Q:$$UPDWL^RCDPEM5($P(RCDIR,U),.RCSPLIT,RCERA)
  1. .;;User abort
  1. .;;K ^TMP($J,"RCDPE_SPLIT_FILE") S VALMBCK="Q"
  1. ;
  1. I RCZ D
  1. . S DIE="^RCY(344.49,"_DA(1)_",1,",DA=RCZ0,RCZT=$P(RCSPLIT(RCZ),U,2)+$P(RCSPLIT(RCZ),U,3)
  1. . S DR=".02////"_$P(RCSPLIT(RCZ),U)_";.05////"_$J(+$P(RCSPLIT(RCZ),U,2),"",2)_";.06////"_$J(+RCZT,"",2)_";.08////"_$J($P(RCSPLIT(RCZ),U,3),"",2)
  1. . S DR=DR_";.07///"_$S($P(RCSPLIT(RCZ),U,5):"/"_$P(RCSPLIT(RCZ),U,5),1:"@")_";.03////"_$S(RCZT'<0:$J(+RCZT,"",2),1:"0.00")_$S($P(RCSPLIT(RCZ),U,6)'="":";.1///"_$S($P(RCSPLIT(RCZ),U,6)'="@":"/^S X=$P(RCSPLIT(RCZ),U,6)",1:"@"),1:"")
  1. . D ^DIE,UPD^RCDPEWL3(DA(1),DA)
  1. . I $P(RCDIR,U,3) D
  1. .. N DA
  1. .. S DA(2)=RCSCR,DA(1)=RCZ0,DA=1,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
  1. .. S RCZZ(1)=$G(^RCY(344.49,DA(2),1,DA(1),1,1,0))
  1. .. S DR=".03////"_$J(+$P(RCSPLIT(RCZ),U,3),"",2)_$S($P(RCSPLIT(RCZ),U,4)'="":".09////"_$P(RCSPLIT(RCZ),U,4),1:"")
  1. .. D ^DIE
  1. F S RCZ=$O(RCSPLIT(RCZ)) Q:'RCZ D
  1. . S DIC(0)="L",DLAYGO=344.491,DIC="^RCY(344.49,"_DA(1)_",1,",X=+$O(^RCY(344.49,RCSCR,1,"B",RCZZ\1+.999),-1)+.001
  1. . S DIC("DR")=".02////"_$P(RCSPLIT(RCZ),U)_";.05////"_$J(+$P(RCSPLIT(RCZ),U,2),"",2)_";.08////"_$J(+$P(RCSPLIT(RCZ),U,3),"",2)_";.06////"_$J($P(RCSPLIT(RCZ),U,2)+$P(RCSPLIT(RCZ),U,3),"",2)
  1. . I $P(RCSPLIT(RCZ),U,6)'="" S DIC("DR")=DIC("DR")_";.1///"_$S($P(RCSPLIT(RCZ),U,6)'="@":"/^S X=$P(RCSPLIT(RCZ),U,6)",1:"@")
  1. . I $P(RCSPLIT(RCZ),U,5) S DIC("DR")=DIC("DR")_";.07////"_$P(RCSPLIT(RCZ),U,5)
  1. . K DD,DO D FILE^DICN K DIC,DLAYGO,DD,DO
  1. . S RCZ1=+Y
  1. . I Y D UPD^RCDPEWL3(RCSCR,RCZ1)
  1. . I Y,$P(RCDIR,U,3) D
  1. .. N DA
  1. .. S DA(2)=RCSCR,DA(1)=RCZ1,X=1,DIC(0)="L",DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",1,"
  1. .. S DIC("DR")=".02////"_$P(RCZZ(1),U,2)_";.03////"_$J(+$P(RCSPLIT(RCZ),U,3),"",2)_$S($P(RCSPLIT(RCZ),U,4)'="":";.09////"_$P(RCSPLIT(RCZ),U,4),$P(RCZZ(1),U,9)'="":";.09////"_$P(RCZZ(1),U,9),1:"")
  1. .. F Z=4:1:8 I $P(RCZZ(1),U,Z)'="" S DIC("DR")=DIC("DR")_";"_(Z/100)_"////"_$P(RCZZ(1),U,Z)
  1. .. D FILE^DICN K DIC,DLAYGO,DD,DO
  1. K ^TMP($J,"RCDPE_SPLIT_FILE")
  1. S VALMBCK="Q"
  1. Q
  1. ;
  1. SELBAT(RCERA,RCQUIT) ; Select a batch
  1. ; If batch is selected, global ^TMP("RCBATCH_SELECTED",$J) is set =
  1. ; batch ien selected
  1. ; RCQUIT = 1 if selection not made
  1. ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
  1. Q ;prca*4.5*298
  1. N DA,DIC,DIE,DIR,DR,DTOUT,DUOUT,RCBAT,X,Y
  1. S RCQUIT=0
  1. S DA(1)=RCERA,DIC(0)="AEMQ",DIC="^RCY(344.49,"_DA(1)_",3,",DIC("S")="I '$P(^(0),U,5)" D ^DIC
  1. I Y'>0 S RCQUIT=1 Q
  1. S RCBAT=+Y
  1. L +^RCY(344.4,RCERA,0):5 I '$T S DIR("A",1)="ANOTHER USER HAS JUST ACCESSED THE ENTIRE ERA - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1 Q
  1. L +^RCY(344.49,RCERA,3,RCBAT,0):5 I '$T!$P($G(^(0)),U,5) S DIR("A",1)="ANOTHER USER HAS JUST OPENED THIS BATCH - TRY AGAIN LATER",DIR("A")="PRESS RETURN TO CONTINUE ",DIR(0)=-"EA" W ! D ^DIR K DIR S RCQUIT=1 Q
  1. S DA=RCBAT,DA(1)=RCERA,DIE="^RCY(344.49,"_DA(1)_",3,",DR=".05////1" D ^DIE L -^RCY(344.49,RCERA,3,RCBAT,0)
  1. I $P($G(^RCY(344.49,RCERA,3,RCBAT,0)),U,3) D
  1. . S DIR(0)="EA",DIR("A",1)="** WARNING - THIS BATCH HAS BEEN FLAGGED AS READY TO POST",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
  1. S ^TMP("RCBATCH_SELECTED",$J)=RCBAT
  1. L -^RCY(344.4,RCERA,0)
  1. Q
  1. ;
  1. SORT ; Select a new sort for the list of ERAs
  1. D FULL^VALM1
  1. N RCSORT,DUOUT,DTOUT,DIR,X,Y,RCS1,RCS2,RCORD
  1. S VALMBCK="R"
  1. S DIR("L",1)=" SELECT A FIRST LEVEL SORT",DIR("L",2)=" "
  1. S DIR("L",3)=" A AMOUNT PAID E ERA PAID DATE"
  1. S DIR("L")=" P PAYER NAME D DATE ERA RECEIVED"
  1. S DIR(0)="S^A:AMOUNT PAID;E:ERA PAID DATE;P:PAYER NAME;D:DATE ERA RECEIVED",DIR("B")=$P($P(DIR(0),"D:",2),";")
  1. W ! D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. S RCS1=$S(Y="A":"AP",Y="E":"DP",Y="P":"PN",1:"DR")
  1. S RCORD=$$ORD(.RCS1)
  1. Q:'$D(RCS1)
  1. S $P(RCSORT,U)=(RCS1_";"_RCORD)
  1. K X
  1. S X(1)=$S(RCS1'="AP":"A:AMOUNT PAID",1:"E:ERA PAID DATE")
  1. S X(2)=$S(RCS1'="AP"&(RCS1'="DP"):"E:ERA PAID DATE",1:"P:PAYER NAME")
  1. S X(3)=$S(RCS1="DR":"P:PAYER NAME",1:"D:DATE ERA RECEIVED")
  1. S DIR(0)="S^N:NONE;"_X(1)_";"_X(2)_";"_X(3)
  1. S DIR("B")="NONE"
  1. S DIR("L",1)=" SELECT A SECOND LEVEL SORT",DIR("L",2)=" "
  1. S DIR("L",3)=" N NONE"_$J("",13)_$P(X(1),":")_" "_$P(X(1),":",2)
  1. S DIR("L")=" "_$E($P(X(2),":")_" "_$P(X(2),":",2)_$J("",20),1,20)_$P(X(3),":")_" "_$P(X(3),":",2)
  1. K X W ! D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. S RCS2=$S(Y="N":"N",Y="A":"AP",Y="E":"DP",Y="P":"PN",1:"DR")
  1. S RCORD=$$ORD(.RCS2)
  1. Q:'$D(RCS2)
  1. S $P(RCSORT,U,2)=(RCS2_";"_RCORD)
  1. K ^TMP($J,"RCERA_LIST") D BLD^RCDPEWL7(RCSORT)
  1. Q
  1. ;
  1. ORD(RCS) ; Select an order for the sorted field code in RCS
  1. ; Kill RCS if nothing selected, passed by reference
  1. ; Returns '-' if reverse order selected
  1. N DIR,X,Y,ORD,RCQUIT
  1. S RCQUIT=0,ORD=""
  1. I RCS="N" G ORDQ
  1. I RCS="PN" D G ORDQ
  1. . S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
  1. . S DIR("B")=$P($P(DIR(0),"F:",2),";")
  1. . S DIR("A")=" SORT (F)IRST TO LAST OR (L)AST TO FIRST?: "
  1. . D ^DIR K DIR
  1. . I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
  1. . S ORD=$S(Y="F":"",1:"-")
  1. ;
  1. I RCS="AP" D G ORDQ
  1. . S DIR("A")=" SORT (L)OWEST TO HIGHEST OR (H)IGHEST TO LOWEST?: "
  1. . S DIR(0)="SA^L:LOWEST TO HIGHEST;H:HIGHEST TO LOWEST"
  1. . S DIR("B")=$P($P(DIR(0),"L:",2),";")
  1. . D ^DIR K DIR
  1. . I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
  1. . S ORD=$S(Y="L":"",1:"-")
  1. ;
  1. I RCS="DP"!(RCS="DR") D G ORDQ
  1. . S DIR("A")=" SORT (E)ARLIEST TO LATEST OR (L)ATEST TO EARLIEST?: "
  1. . S DIR(0)="SA^E:EARLIEST TO LATEST;L:LATEST TO EARLIEST"
  1. . S DIR("B")=$P($P(DIR(0),"E:",2),";")
  1. . D ^DIR K DIR
  1. . I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
  1. . S ORD=$S(Y="E":"",1:"-")
  1. ;
  1. ; Invalid sort code
  1. S RCQUIT=1
  1. ;
  1. ORDQ I RCQUIT K RCS
  1. Q ORD
  1. ;
  1. BATDSP ; Ask Display/Hide batch info on ERA list screen
  1. ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
  1. Q ;prca*4.5*298
  1. N DIR,DTOUT,DUOUT,RCZ,X,Y
  1. D FULL^VALM1
  1. S RCZ=+$G(^TMP("RCERA_PARAMS",$J,"BATCHON"))
  1. S DIR("A",1)="BATCH INFO DISPLAY IS CURRENTLY TURNED "_$S('RCZ:"OFF",1:"ON"),DIR("A")="DO YOU WANT TO TURN IT "_$S('RCZ:"ON",1:"OFF")_" NOW?: "
  1. S DIR(0)="YA",DIR("B")="YES" W ! D ^DIR K DIR
  1. S VALMBCK="R"
  1. Q:$D(DUOUT)!$D(DTOUT)!'Y
  1. S ^TMP("RCERA_PARAMS",$J,"BATCHON")=$S(RCZ:0,1:1)
  1. D BLD^RCDPEWL7($G(^TMP("RCERA_PARAMS",$J,"SORT")))
  1. Q
  1. ;
  1. HASADJ(RCSCR,RCOK) ; Function=1 if WL entry has any adj not yet distributed
  1. ; RCSCR = ien of entry in file 344.49
  1. ; RCOK = if passed by reference, returns 1 if ANY postable lines exist
  1. N Z,Z0,RCSTOP
  1. S RCSTOP=0,RCOK=0
  1. S Z=0 F S Z=$O(^RCY(344.49,RCSCR,1,Z)) Q:'Z S Z0=$G(^(Z,0)) D Q:RCSTOP
  1. . ;HIPAA 5010 - negative value now takes precedence over adjustment
  1. . I $P(Z0,U,6)>0!$O(^RCY(344.49,RCSCR,1,Z,1,0)) S RCOK=1
  1. . I $P(Z0,U,6)<0 S RCSTOP=1
  1. Q RCSTOP
  1. ;
  1. VERIF ;EP - Protocol action - RCDPE EOB WORKLIST VERIFY
  1. ; Entrypoint to verification options
  1. N DIR,DTOUT,DUOUT,RCAUTO,RCQUIT,X,Y ; PRCA*4.5*326
  1. D FULL^VALM1
  1. I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
  1. . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ; BEGIN PRCA*4.5*326
  1. ;I $S($P($G(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0) D NOEDIT^RCDPEWLP G VERIFQ ;prca*4.5*298 auto-posted ERAs cannot enter VERIFY action
  1. S RCAUTO=$$GET1^DIQ(344.4,RCSCR_",",4.02,"I") ; Autopost status
  1. ; If ERA is an auto-post allow report only
  1. I RCAUTO]"" D RPT1^RCDPEV0(RCERA) W !! Q
  1. ; END PRCA*4.5*326
  1. ;
  1. W !!!!
  1. S RCQUIT=0
  1. F D Q:RCQUIT
  1. . W !,"VERIFY EEOBs:",!,?10,"1",$J("",5),"MANUALLY MARK AS VERIFIED",!,?10,"2",$J("",5),"REPORT OF UNVERIFIED WITH DISCREPANCIES",!,?10,"3",$J("",5),"QUIT AND RETURN TO WORKLIST"
  1. . S DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
  1. . S DIR("A")="Select Action: ",DIR("B")="QUIT" W ! D ^DIR K DIR
  1. . I Y=3!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
  1. . ;
  1. . I Y=1 D MVER^RCDPEV(RCERA) W !! Q
  1. . ;
  1. . I Y=2 D RPT^RCDPEV0(RCERA) W !! Q
  1. ;
  1. VERIFQ S VALMBCK="R"
  1. Q
  1. ;
  1. BATED ; Entry point to batch edit options
  1. ; prca*4.5*298 per requirements, keep code for creating/maintaining batches but remove from execution
  1. Q ; prca*4.5*298
  1. N DA,DIC,DIR,DTOUT,DUOUT,RCQUIT,X,Y
  1. D FULL^VALM1
  1. ;
  1. W !!!!
  1. S RCQUIT=0
  1. I '$O(^RCY(344.49,RCERA,3,0)) W !,"***** THERE ARE CURRENTLY NO BATCHES DEFINED FOR THIS ERA *****",!
  1. ; No menu if entering from a batch level
  1. I $G(^TMP("RCBATCH_SELECTED",$J)) W !,"EDITING BATCH #"_+^TMP("RCBATCH_SELECTED",$J) D EDIT^RCDPEWLB(RCERA,+^TMP("RCBATCH_SELECTED",$J)) G BATEDQ
  1. F D Q:RCQUIT
  1. . I '$D(^XUSEC("PRCA ERA BATCH MAINT",DUZ)) D Q
  1. .. S RCQUIT=1
  1. .. S DIR(0)="EA",DIR("A")="YOU DO NOT HAVE SECURITY ACCESS TO THIS ACTION - Press ENTER to continue: " W ! D ^DIR K DIR
  1. .;
  1. . W !,"BATCH MAINTENANCE:",!,?10,"1",$J("",5),"EDIT BATCH",!,?10,"2",$J("",5),"NEW BATCH ASSIGNMENT",!,?10,"3",$J("",5),"MARK ALL READY TO POST",!,?10,"4",$J("",5),"BATCH SUMMARY REPORT",!,?10,"5",$J("",5),"QUIT AND RETURN TO WORKLIST"
  1. . S DIR(0)="SAO^1:EDIT BATCH;2:NEW BATCHES;3:MARK ALL;4:BATCH SUMMARY;5:QUIT"
  1. . S DIR("A")="Select Action: ",DIR("B")="Quit" W ! D ^DIR K DIR
  1. . I Y="5"!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
  1. . ;
  1. . I Y=1 D W !! Q
  1. .. I '$O(^RCY(344.49,RCERA,3,0)) D NOTSET^RCDPEWLC Q
  1. .. S DIR("B")="ONE",DIR(0)="SA^A:ALL;O:ONE",DIR("A")="EDIT(A)LL or (O)NE BATCH?: " W ! D ^DIR K DIR
  1. .. I $D(DTOUT)!$D(DUOUT) Q
  1. .. I Y="A" D EDITALL^RCDPEWLB(RCERA) Q
  1. .. S DA(1)=RCERA,DIC="^RCY(344.49,"_DA(1)_",3,",DIC(0)="AEMQ" D ^DIC
  1. .. Q:Y'>0
  1. .. D EDIT^RCDPEWLB(RCERA,+Y)
  1. . ;
  1. . I Y=2 D REBATCH^RCDPEWLB(RCERA) W !! Q
  1. . ;
  1. . I Y=3 D MARKALL^RCDPEWLB(RCERA) W !! Q
  1. . ;
  1. . I Y=4 D SUMRPT^RCDPEWLC(RCERA) W !! Q
  1. ;
  1. BATEDQ S VALMBCK="R"
  1. Q
  1. ;
  1. AUTOPOST(SOURCE) ;EP Protocol action - RCDPE EOB WORKLIST MARK FOR AUTO POST
  1. ; Input:
  1. ; SOURCE
  1. ; 1:Called by Worklist (RCDPE WORKLIST ERA MARK FOR AUTO POST)
  1. ; 2:Called by Scratchpad (RCDPE WORKLIST EOB MARK FOR AUTO POST)
  1. ; If SOURCE=2, RCSCR will be set to the IEN of 344.4
  1. ;
  1. D FULL^VALM1
  1. I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
  1. . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ;
  1. ; If called by Worklist (SOURCE=1), then ask which ERA
  1. ; If called by Scratchpad (SOURCE=2), ERA is already in variable RCSCR
  1. N RCERA
  1. I SOURCE=1 S RCERA=$$SEL^RCDPEWL7()
  1. I SOURCE=2 S RCERA=$G(RCSCR)
  1. I 'RCERA S VALMBCK="R" Q
  1. ;
  1. N AUTOPOST
  1. S AUTOPOST=$$AUTOCHK2^RCDPEAP1(RCERA,0) ; added parameter - PRCA*4.5*321
  1. I AUTOPOST D
  1. . D SETSTA^RCDPEAP(RCERA,0,"Worklist: Marked as Auto-Post Candidate")
  1. . W !,"ERA has been successfully Marked as an Auto-Post CANDIDATE"
  1. I 'AUTOPOST D
  1. . D AUDITLOG^RCDPEAP(RCERA,"","Worklist: Not Marked as Auto-Post Candidate-"_$P(AUTOPOST,U,2))
  1. . W !,"ERA was NOT Marked as an Auto-Post CANDIDATE - ",$P(AUTOPOST,U,2)
  1. ;
  1. AUTOPSTQ ;
  1. K DIR
  1. S DIR(0)="E" D ^DIR
  1. S VALMBCK="R"
  1. Q