- RCDPEAA3 ;ALB/KML - APAR Screen - callable entry points ;Nov 24, 2014@23:32:24
- ;;4.5;Accounts Receivable;**298,304,318,332**;Mar 20, 1995;Build 40
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- SPLIT(RCIENS) ;EP - Protocol action - RCDPE APAR SPLINE LINE
- ; Split EEOB in APAR
- ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
- ; 344.491^selectable line item from listman screen
- N DIR,L,RCQUIT,X
- S RCQUIT=0
- D FULL^VALM1
- I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
- . S VALMBCK="R"
- . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
- . D PAUSE^VALM1
- S L=0
- F S L=$O(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),1,L)) Q:'L I "01"[$P($G(^(L,0)),U,2) D G SPLITQ
- . S DIR(0)="EA",DIR("A",1)="THIS EEOB IS NOT AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE "
- . W ! D ^DIR K DIR
- I $P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,13) D G:RCQUIT SPLITQ
- . S DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
- . I Y'=1 S RCQUIT=1
- K ^TMP("RCDPE_SPLIT_REBLD",$J)
- S X=+$O(^TMP("RCDPE-EOB_WLDX",$J,""),-1)
- D SPLIT^RCDPEWL3($P(RCIENS,U),X)
- I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D INIT^RCDPEAA2(RCIENS)
- ;
- SPLITQ S VALMBCK="R"
- Q
- ;
- REFRESH(RCIENS) ;EP - Protocol action - RCDPE APAR EEOB REFRESH - PRCA*4.5*332 subroutine re-written
- ; Refresh the entry in file 344.49 to remove all user adjustments
- ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
- ; 344.491^selectable line item from listman screen
- N DA,DIK,DIR,DONE,IENS,OSEQ,SEQ,X,XX,Y,Z,ZZ,Z0
- D FULL^VALM1
- S XX=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_","
- S SEQ=$$GET1^DIQ(344.491,XX,.01,"I") ; Line Sequence #
- I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
- . S VALMBCK="R"
- . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
- . D PAUSE^VALM1
- ;
- S DIR(0)="YA"
- S DIR("A",1)="This action will delete and rebuild this EEOB Worklist Scratch Pad for Line "_SEQ_"."
- S DIR("A",2)="All Splits/Edits/Reviews entered for this line will be erased and all entries"
- S DIR("A",3)="marked as manually verified will be unmarked.",DIR("A",4)=" "
- S DIR("A")="ARE YOU SURE YOU WANT TO DO THIS? "
- W !
- D ^DIR
- K DIR
- I Y'=1 D REFQ Q
- ;
- ; First remove Review and Verify information
- S DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1)
- S DIE="^RCY(344.49,"_DA(1)_",1,",DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1)
- S DR=".1///@;.11///@;.12///@;.13///@"
- D ^DIE
- S XX=0,DA(2)=DA(1),DA(1)=DA
- F D Q:'XX
- . S XX=$O(^RCY(344.49,DA(2),1,DA(1),4,XX))
- . Q:'XX
- . S DA=XX
- . S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
- . D ^DIK
- ;
- ; Next remove distributed adjustments
- S XX=0
- F D Q:'XX
- . S XX=$O(^RCY(344.49,DA(2),1,DA(1),1,XX))
- . Q:'XX
- . S DA=XX,DIK="^RCY(344.49,"_DA(2)_"1,"_DA(1)_",1,"
- . D ^DIK
- ;
- ; Finally remove Split/Edited lines
- K DA
- S IENS=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_","
- D GETS^DIQ(344.491,IENS,"**","I","OSEQ") ; Get Original line values
- S DA=$P(RCIENS,"^",2)+1,DA(1)=$P(RCIENS,"^",1)
- K DR
- S DIE="^RCY(344.49,"_DA(1)_",1,"
- S DR=".02///"_OSEQ(344.491,IENS,.02,"I")_";" ; Original Claim #
- S DR=DR_".03///"_OSEQ(344.491,IENS,.03,"I")_";" ; Amount to Post on Receipt
- S DR=DR_".04///"_OSEQ(344.491,IENS,.04,"I")_";" ; Include on Receipt
- S DR=DR_".05///"_OSEQ(344.491,IENS,.05,"I")_";" ; Amount of Payment
- S DR=DR_".06///"_OSEQ(344.491,IENS,.06,"I")_";" ; Net Amount of Payment
- ;
- ; PRCA*4.5*332 - AR Bill pointer goes in .07 field. It is populated during scratchpad creation
- ; but when refreshing we need to derive it from the old bill number in the .02 field.
- S Z0=""
- S ZZ=OSEQ(344.491,IENS,.02,"I")
- I ZZ'="" S Z0=$O(^DGCR(399,"B",ZZ,""))
- S DR=DR_".07///"_$S(Z0:Z0,1:"@")_";" ; AR Bill (399 or 430 IEN)
- ;
- S DR=DR_".08///@;.09///@;.10///@;2.03///@;2.04///@" ; Null out the other fields
- D ^DIE
- S XX=DA,DONE=0
- F D Q:DONE
- . S XX=$O(^RCY(344.49,DA(1),1,XX))
- . I 'XX S DONE=1 Q
- . Q:$P($P(^RCY(344.49,DA(1),1,XX,0),"^",1),".",1)'=SEQ ; Not line being refreshed
- . S DA=XX,DIK="^RCY(344.49,"_DA(1)_",1,"
- . D ^DIK
- ;
- D INIT^RCDPEAA2(RCIENS)
- REFQ ;
- S VALMBG=1,VALMBCK="R"
- Q
- ;
- RESEARCH ; Invoke the research menu off APAR
- ;
- K ^TMP($J,"RC_VALMBG")
- S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
- D FULL^VALM1
- D EN^VALM("RCDPE APAR EEOB RESEARCH")
- RQ K ^TMP($J,"RC_VALMBG")
- Q
- ;
- VRECPT(RCIENS) ;
- ;
- ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
- ;
- D VR^RCDPEWLP($P(RCIENS,U))
- Q
- REVIEW(RCIENS) ; Enter review information on worklist and turn review display on/off
- ;
- ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
- ;
- ;
- N Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
- D FULL^VALM1
- ;
- S REVCHG=""
- S DIR(0)="YA",RC=+$G(^TMP($J,"RC_REVIEW"))
- S DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$P("OFF^ON",U,RC+1),DIR("A")="DO YOU WANT TO TURN IT "_$P("ON^OFF",U,RC+1)_"?: ",DIR("B")=$S('RC:"YES",1:"NO") W ! D ^DIR K DIR
- I Y=1 S ^TMP($J,"RC_REVIEW")=((RC+1)#2),REVCHG=1
- S RCUSPREF=+$O(^RCY(344.49,$P(RCIENS,U),2,"B",DUZ,0))
- ;
- I 'RCUSPREF D ; Add the user pref record
- . S RCUSPREF=+$$ADDUSER($P(RCIENS,U),DUZ)
- S RCLSTREV=+$P($G(^RCY(344.49,$P(RCIENS,U),2,RCUSPREF,0)),U,2)
- S DA(1)=$P(RCIENS,U),DA=RCUSPREF
- I DA,RCLSTREV'=$G(^TMP($J,"RC_REVIEW")) D ; Update user pref
- . S DIE="^RCY(344.49,"_DA(1)_",2,",DR=".02////"_+$G(^TMP($J,"RC_REVIEW")) D ^DIE
- W !
- I '$G(^TMP($J,"RC_REVIEW")) G REVIEWQ
- ;
- D SEL^RCDPEWL(.RCDA)
- S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) G:'RCZ REVIEWQ
- ;
- S RCREV=0
- I '$O(^RCY(344.49,$P(RCIENS,U),1,"AC",DUZ,RCZ,0)) D
- . S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ)
- E D
- . N DIR,X,Y
- . S DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B")="ADD",DIR(0)="SA^A:ADD;E:EDIT" W ! D ^DIR K DIR
- . I $D(DUOUT)!$D(DTOUT) Q
- . ;
- . I Y="E" D Q ; Edit a review entry entered by same user
- .. N DA,DR,DIE,X,Y
- .. S DA(1)=$P(RCIENS,U),DA=RCZ,DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ" D ^DIC
- .. S RCREV=$S(Y>0:+Y,1:0)
- .. I RCREV S DA(2)=$P(RCIENS,U),DA(1)=RCZ,DA=RCREV,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DR=".03;.04////^S X=$$NOW^XLFDT()" D ^DIE
- . ;
- . S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ)
- ;
- I RCREV S DIE("NO^")="",DA(1)=$P(RCIENS,U),DA=RCZ,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20" D ^DIE K DIE
- D INIT^RCDPEAA2(RCIENS)
- S REVCHG=""
- ;
- REVIEWQ I $G(REVCHG) D INIT^RCDPEAA2(RCIENS)
- S VALMBCK="R"
- Q
- ;
- NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
- ; RCSCR = ien of entry in file 344.49
- ; RCZ = ien of the EEOB (seq #)
- ; RCDUZ =DUZ of user entering the comment
- ; Function returns 0 if no new comment, ien of comment if added
- N DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
- S RCNOW=$$NOW^XLFDT() W !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
- S DA(2)=RCSCR,DA(1)=RCZ,X=RCNOW,DIC("DR")=".02////"_RCDUZ_";.03",DLAYGO=344.492,DIC(0)="L"
- S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
- K DO,DD
- D FILE^DICN K DO,DD,DIC,DLAYGO
- S RCREV=+Y
- I RCREV'>0 S RCREV=0 G NEWREVQ
- I '$O(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0)) S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DA=RCREV D ^DIK S RCREV=0 ; No comment - delete entry
- ;
- NEWREVQ Q RCREV
- ;
- ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
- ; RCSCR = ien of entry in file 344.49
- ; RCDUZ = the ien of the user
- N DIC,DA,X,Y,DLAYGO,DO,DD
- S Y=+$O(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
- I Y G ADDUQ
- S DLAYGO=344.492,DA(1)=RCSCR,DIC(0)="L",X=RCDUZ,DIC="^RCY(344.49,"_DA(1)_",2,",DIC("DR")=".02////0;.03////N"
- D FILE^DICN K DIC,DLAYGO
- ADDUQ Q $S(Y>0:Y,1:0)
- ;
- PREOB(RCIENS) ; Print/View EOB detail
- N RCDA,RCDAZ,Z,Z0
- D FULL^VALM1
- S RCDA=$P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,9)
- F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
- S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D
- . ;
- . S Z0=RCDAZ(Z)
- . I $E(Z0,1,3)="ADJ" D Q
- .. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
- . ;
- . S Z0=$G(^RCY(344.4,$P(RCIENS,U),1,+Z0,0))
- . S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
- ;
- D VP^RCDPEWL2($P(RCIENS,U),.RCDAZ)
- ;
- S VALMBCK="R"
- Q
- ;
- VERIF(RCIENS) ;EP - Protocol action RCDPE APAR VERIFY
- ; Entry point to verification options on APAR worklist
- ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
- ; 344.491^selectable line item from listman screen
- N DIR,DIRUT,DTOUT,DUOUT,RCQUIT,X,Y
- D FULL^VALM1
- I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
- . S VALMBCK="R"
- . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
- . D PAUSE^VALM1
- ;
- W !!!!
- S RCQUIT=0
- F D Q:RCQUIT
- . S DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
- . S DIR("A",1)="VERIFY EEOBs:"
- . S DIR("A",2)=" 1 MANUALLY MARK AS VERIFIED"
- . S DIR("A",3)=" 2 REPORT OF UNVERIFIED WITH DISCREPANCIES"
- . S DIR("A",4)=" 3 QUIT AND RETURN TO WORKLIST"
- . S DIR("A")="Select Action: ",DIR("B")="QUIT" W ! D ^DIR K DIR
- . I Y=3!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
- . ;
- . I Y=1 D MVER($P(RCIENS,U)) W !! Q
- . ;
- . I Y=2 D RPT^RCDPEV0($P(RCIENS,U)) W !! Q
- ;
- S VALMBCK="R"
- Q
- ;
- MVER(RCERA) ; Manually mark an EEOB as verified within APAR
- ; subroutine cloned from the process that VERIFIES EEOBs off the standard worklist (MVER^RCDPEV)
- ; but with specific changes to support APAR
- ; this subroutine only needs to VERIFY one EEOB rather than a list of EEOBs
- N A,CT,DA,DIE,DR,DTOUT,DUOUT,Z,Z0,Z1,RCT,RCY,RCY0,RCZ0,RCLINE,RCYNUM,DIR,X,Y,RESULT,SPLIT,Q,Q0,DT1,DT2
- N VERIFIED
- S (VERIFIED,RCT)=0,CT=1,Z0=""
- ; get the EEOB entry ien to determine if already it's already been verified
- S Z1=$O(^TMP("RCDPE-EOB_WLDX",$J,"")) I Z1 S Z=^TMP("RCDPE-EOB_WLDX",$J,Z1)
- ; grab the data belonging to the EEOB
- I Z]"" S Z0=$G(^RCY(344.49,RCERA,1,+$P(Z,U,2),0))
- ; get VERIFY data
- I Z0'="",$P(Z0,U,13) S VERIFIED=1
- I VERIFIED D Q
- . S DIR(0)="EA",DIR("A",1)="THIS EEOB IS ALREADY VERIFIED",DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
- S RCY=+$P($G(^TMP("RCDPE-EOB_WLDX",$J,Z1)),U,2),RCLINE=+^(Z1),RCYNUM=Z1
- S RCY0=$G(^RCY(344.49,RCERA,1,RCY,0))
- S RCZ0=$G(^RCY(344.4,RCERA,1,+$P(RCY0,U,9),0))
- I '$P(RCZ0,U,2) D
- . W !!,"THIS LINE DOES NOT REFERENCE A VALID BILL"
- E D
- . S RESULT=$$VER^RCDPEV(RCERA,+$G(^IBM(361.1,+$P(RCZ0,U,2),0)),+$P(RCY0,U,9),1)
- . F Z=2:1:9 I $E($P(RESULT,U,Z))="*" S Q=$P(RESULT,U,Z),$E(Q,1)="",$P(RESULT,U,Z)=Q
- . S SPLIT=$O(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001")
- . S Z=$S(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ")
- . S Z=Z_$P(RCY0,U,2)_$S('SPLIT:"",1:" (ORIGINAL ERA DATA)")
- . I SPLIT D
- .. S Q=+RCY0 F S Q=$O(^RCY(344.49,RCERA,1,"B",Q)) Q:(Q\1)'=+RCY0 S Q0=+$O(^RCY(344.49,RCERA,1,"B",Q,0)),Q0=$G(^RCY(344.49,RCERA,1,Q0,0)) I $P(Q0,U,2)'="" S Z=Z_" "_$P(Q0,U,2)
- . W !!!,Z
- . W !,?13,"PATIENT NAME"_$J("",18)_" SUBMITTED AMT SVC DATE(S)"
- . W !,?13,"------------------------------ --------------- -----------------"
- . S DT1=$E($S($P(RESULT,U,7):$$FMTE^XLFDT($P(RESULT,U,7),"2D"),1:"NOTFOUND")_$J("",8),1,8)
- . S DT2=$E($S($P(RESULT,U,9):"-"_$$FMTE^XLFDT($P(RESULT,U,9),"2D"),1:"-NOTFOUND")_$J("",9),1,9)
- . W !," ERA DATA: ",$E($P(RESULT,U,3)_$J("",30),1,30)," ",$E($J($P(RESULT,U,5),"",2)_$J("",15),1,15)_" "_DT1_DT2
- . W !,?15,$P($G(^RCY(344,RCERA,0)),U,6)
- . S DT1=$E($S($P(RESULT,U,6):$$FMTE^XLFDT($P(RESULT,U,6),"2D"),1:"NOTFOUND")_$J("",8),1,8)
- . S DT2=$E($S($P(RESULT,U,8):"-"_$$FMTE^XLFDT($P(RESULT,U,8),"2D"),1:"-NOTFOUND")_$J("",9),1,9)
- . W !," BILL DATA: "_$E($P(RESULT,U,2)_$J("",30),1,30)_" "_$E($J($P(RESULT,U,4),"",2)_$J("",15),1,15)_" "_DT1_DT2
- . W !,?15,$P($G(^DIC(36,+$P(RCZ0,U,4),0)),U),!
- S DIR(0)="YA",DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? ",DIR("B")="NO" W ! D ^DIR K DIR
- ;
- I Y'=1 Q
- S DA(1)=RCERA,DA=+RCY,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".13////1" D ^DIE
- S A=$$TOPLINE^RCDPEWL1($G(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM)
- S ^TMP("RCDPE-EOB_WL",$J,RCLINE,0)=A
- Q
- ;
- ;PRCA*4.5*304 - add a claim comment to the ERA detail line from APAR
- COMNT ;
- N IEN,SEQ,DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,ZDA,ZBILL,RCOMMENT,TCOMM
- S RCOMMENT=0
- S IEN=+$P(RCIENS,U,1)
- ; Validate the selection
- I IEN=0 D G COMQ
- . W !,"Cannot comment, no record in file ELECTRONIC REMITTANCE ADVICE file selected." D WAIT^VALM1
- S SEQ=$P(^RCY(344.49,IEN,1,+$P(RCIENS,U,2),0),U,9) ; Just grab the first sequence number for the comment.
- I $G(SEQ)="" D G COMQ
- . W !,"Cannot comment, no ERA detail record selected." D WAIT^VALM1
- I $G(^RCY(344.4,IEN,1,SEQ,0))']"" D G COMQ
- . W !,"Cannot comment, ERA detail record selected not found." D WAIT^VALM1
- ;
- ; Allow user to put comment on this ERA Detail record
- S ZDA=SEQ,ZDA(1)=IEN,ZBILL=$P($$GETBILL^RCDPESR0(.ZDA),"-",2)
- W !,"Enter a comment on ERA #"_IEN_" ERA Detail Seq #",SEQ," Bill #",ZBILL,!
- S DIE="^RCY(344.4,"_IEN_",1,",DA=SEQ,DA(1)=IEN,DR="4Comment" D ^DIE G:$D(DTOUT)!$D(Y) COMQ
- ; Now file user (DUZ) and DATE
- K DR
- ; If DA is not defined then the user deleted the comment with an @,
- ; Delete the user and date too.
- S TCOMM=$$GET1^DIQ(344.41,SEQ_","_IEN_",",4,"E")
- I TCOMM="" S DA=SEQ,DA(1)=IEN,DR="4.01////@;4.02////@;"
- E S DR="4.01////"_$$DT^XLFDT_";4.02////"_$G(DUZ)_";"
- D ^DIE
- S RCOMMENT=1
- D WAIT^VALM1
- ;
- COMQ I RCOMMENT D INIT^RCDPEAA2(RCIENS) ;
- S VALMBCK="R"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAA3 14024 printed Jan 18, 2025@02:45:21 Page 2
- RCDPEAA3 ;ALB/KML - APAR Screen - callable entry points ;Nov 24, 2014@23:32:24
- +1 ;;4.5;Accounts Receivable;**298,304,318,332**;Mar 20, 1995;Build 40
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- SPLIT(RCIENS) ;EP - Protocol action - RCDPE APAR SPLINE LINE
- +1 ; Split EEOB in APAR
- +2 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
- +3 ; 344.491^selectable line item from listman screen
- +4 NEW DIR,L,RCQUIT,X
- +5 SET RCQUIT=0
- +6 DO FULL^VALM1
- +7 ; PRCA*4.5*318 Added security key check
- IF '$DATA(^XUSEC("RCDPEPP",DUZ))
- Begin DoDot:1
- +8 SET VALMBCK="R"
- +9 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
- +10 DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +11 SET L=0
- +12 FOR
- SET L=$ORDER(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),1,L))
- if 'L
- QUIT
- IF "01"[$PIECE($GET(^(L,0)),U,2)
- Begin DoDot:1
- +13 SET DIR(0)="EA"
- SET DIR("A",1)="THIS EEOB IS NOT AVAILABLE TO EDIT/SPLIT"
- SET DIR("A")="PRESS RETURN TO CONTINUE "
- +14 WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- GOTO SPLITQ
- +15 IF $PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),0)),U,13)
- Begin DoDot:1
- +16 SET DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED"
- SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: "
- SET DIR(0)="YA"
- SET DIR("B")="NO"
- WRITE !
- DO ^DIR
- KILL DIR
- +17 IF Y'=1
- SET RCQUIT=1
- End DoDot:1
- if RCQUIT
- GOTO SPLITQ
- +18 KILL ^TMP("RCDPE_SPLIT_REBLD",$JOB)
- +19 SET X=+$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,""),-1)
- +20 DO SPLIT^RCDPEWL3($PIECE(RCIENS,U),X)
- +21 IF $GET(^TMP("RCDPE_SPLIT_REBLD",$JOB))
- KILL ^TMP("RCDPE_SPLIT_REBLD",$JOB)
- DO INIT^RCDPEAA2(RCIENS)
- +22 ;
- SPLITQ SET VALMBCK="R"
- +1 QUIT
- +2 ;
- REFRESH(RCIENS) ;EP - Protocol action - RCDPE APAR EEOB REFRESH - PRCA*4.5*332 subroutine re-written
- +1 ; Refresh the entry in file 344.49 to remove all user adjustments
- +2 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
- +3 ; 344.491^selectable line item from listman screen
- +4 NEW DA,DIK,DIR,DONE,IENS,OSEQ,SEQ,X,XX,Y,Z,ZZ,Z0
- +5 DO FULL^VALM1
- +6 SET XX=$PIECE(RCIENS,"^",2)_","_$PIECE(RCIENS,"^",1)_","
- +7 ; Line Sequence #
- SET SEQ=$$GET1^DIQ(344.491,XX,.01,"I")
- +8 ; PRCA*4.5*318 Added security key check
- IF '$DATA(^XUSEC("RCDPEPP",DUZ))
- Begin DoDot:1
- +9 SET VALMBCK="R"
- +10 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
- +11 DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +12 ;
- +13 SET DIR(0)="YA"
- +14 SET DIR("A",1)="This action will delete and rebuild this EEOB Worklist Scratch Pad for Line "_SEQ_"."
- +15 SET DIR("A",2)="All Splits/Edits/Reviews entered for this line will be erased and all entries"
- +16 SET DIR("A",3)="marked as manually verified will be unmarked."
- SET DIR("A",4)=" "
- +17 SET DIR("A")="ARE YOU SURE YOU WANT TO DO THIS? "
- +18 WRITE !
- +19 DO ^DIR
- +20 KILL DIR
- +21 IF Y'=1
- DO REFQ
- QUIT
- +22 ;
- +23 ; First remove Review and Verify information
- +24 SET DA=$PIECE(RCIENS,"^",2)
- SET DA(1)=$PIECE(RCIENS,"^",1)
- +25 SET DIE="^RCY(344.49,"_DA(1)_",1,"
- SET DA=$PIECE(RCIENS,"^",2)
- SET DA(1)=$PIECE(RCIENS,"^",1)
- +26 SET DR=".1///@;.11///@;.12///@;.13///@"
- +27 DO ^DIE
- +28 SET XX=0
- SET DA(2)=DA(1)
- SET DA(1)=DA
- +29 FOR
- Begin DoDot:1
- +30 SET XX=$ORDER(^RCY(344.49,DA(2),1,DA(1),4,XX))
- +31 if 'XX
- QUIT
- +32 SET DA=XX
- +33 SET DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
- +34 DO ^DIK
- End DoDot:1
- if 'XX
- QUIT
- +35 ;
- +36 ; Next remove distributed adjustments
- +37 SET XX=0
- +38 FOR
- Begin DoDot:1
- +39 SET XX=$ORDER(^RCY(344.49,DA(2),1,DA(1),1,XX))
- +40 if 'XX
- QUIT
- +41 SET DA=XX
- SET DIK="^RCY(344.49,"_DA(2)_"1,"_DA(1)_",1,"
- +42 DO ^DIK
- End DoDot:1
- if 'XX
- QUIT
- +43 ;
- +44 ; Finally remove Split/Edited lines
- +45 KILL DA
- +46 SET IENS=$PIECE(RCIENS,"^",2)_","_$PIECE(RCIENS,"^",1)_","
- +47 ; Get Original line values
- DO GETS^DIQ(344.491,IENS,"**","I","OSEQ")
- +48 SET DA=$PIECE(RCIENS,"^",2)+1
- SET DA(1)=$PIECE(RCIENS,"^",1)
- +49 KILL DR
- +50 SET DIE="^RCY(344.49,"_DA(1)_",1,"
- +51 ; Original Claim #
- SET DR=".02///"_OSEQ(344.491,IENS,.02,"I")_";"
- +52 ; Amount to Post on Receipt
- SET DR=DR_".03///"_OSEQ(344.491,IENS,.03,"I")_";"
- +53 ; Include on Receipt
- SET DR=DR_".04///"_OSEQ(344.491,IENS,.04,"I")_";"
- +54 ; Amount of Payment
- SET DR=DR_".05///"_OSEQ(344.491,IENS,.05,"I")_";"
- +55 ; Net Amount of Payment
- SET DR=DR_".06///"_OSEQ(344.491,IENS,.06,"I")_";"
- +56 ;
- +57 ; PRCA*4.5*332 - AR Bill pointer goes in .07 field. It is populated during scratchpad creation
- +58 ; but when refreshing we need to derive it from the old bill number in the .02 field.
- +59 SET Z0=""
- +60 SET ZZ=OSEQ(344.491,IENS,.02,"I")
- +61 IF ZZ'=""
- SET Z0=$ORDER(^DGCR(399,"B",ZZ,""))
- +62 ; AR Bill (399 or 430 IEN)
- SET DR=DR_".07///"_$SELECT(Z0:Z0,1:"@")_";"
- +63 ;
- +64 ; Null out the other fields
- SET DR=DR_".08///@;.09///@;.10///@;2.03///@;2.04///@"
- +65 DO ^DIE
- +66 SET XX=DA
- SET DONE=0
- +67 FOR
- Begin DoDot:1
- +68 SET XX=$ORDER(^RCY(344.49,DA(1),1,XX))
- +69 IF 'XX
- SET DONE=1
- QUIT
- +70 ; Not line being refreshed
- if $PIECE($PIECE(^RCY(344.49,DA(1),1,XX,0),"^",1),".",1)'=SEQ
- QUIT
- +71 SET DA=XX
- SET DIK="^RCY(344.49,"_DA(1)_",1,"
- +72 DO ^DIK
- End DoDot:1
- if DONE
- QUIT
- +73 ;
- +74 DO INIT^RCDPEAA2(RCIENS)
- REFQ ;
- +1 SET VALMBG=1
- SET VALMBCK="R"
- +2 QUIT
- +3 ;
- RESEARCH ; Invoke the research menu off APAR
- +1 ;
- +2 KILL ^TMP($JOB,"RC_VALMBG")
- +3 SET ^TMP($JOB,"RC_VALMBG")=$GET(VALMBG)
- +4 DO FULL^VALM1
- +5 DO EN^VALM("RCDPE APAR EEOB RESEARCH")
- RQ KILL ^TMP($JOB,"RC_VALMBG")
- +1 QUIT
- +2 ;
- VRECPT(RCIENS) ;
- +1 ;
- +2 ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
- +3 ;
- +4 DO VR^RCDPEWLP($PIECE(RCIENS,U))
- +5 QUIT
- REVIEW(RCIENS) ; Enter review information on worklist and turn review display on/off
- +1 ;
- +2 ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
- +3 ;
- +4 ;
- +5 NEW Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
- +6 DO FULL^VALM1
- +7 ;
- +8 SET REVCHG=""
- +9 SET DIR(0)="YA"
- SET RC=+$GET(^TMP($JOB,"RC_REVIEW"))
- +10 SET DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$PIECE("OFF^ON",U,RC+1)
- SET DIR("A")="DO YOU WANT TO TURN IT "_$PIECE("ON^OFF",U,RC+1)_"?: "
- SET DIR("B")=$SELECT('RC:"YES",1:"NO")
- WRITE !
- DO ^DIR
- KILL DIR
- +11 IF Y=1
- SET ^TMP($JOB,"RC_REVIEW")=((RC+1)#2)
- SET REVCHG=1
- +12 SET RCUSPREF=+$ORDER(^RCY(344.49,$PIECE(RCIENS,U),2,"B",DUZ,0))
- +13 ;
- +14 ; Add the user pref record
- IF 'RCUSPREF
- Begin DoDot:1
- +15 SET RCUSPREF=+$$ADDUSER($PIECE(RCIENS,U),DUZ)
- End DoDot:1
- +16 SET RCLSTREV=+$PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),2,RCUSPREF,0)),U,2)
- +17 SET DA(1)=$PIECE(RCIENS,U)
- SET DA=RCUSPREF
- +18 ; Update user pref
- IF DA
- IF RCLSTREV'=$GET(^TMP($JOB,"RC_REVIEW"))
- Begin DoDot:1
- +19 SET DIE="^RCY(344.49,"_DA(1)_",2,"
- SET DR=".02////"_+$GET(^TMP($JOB,"RC_REVIEW"))
- DO ^DIE
- End DoDot:1
- +20 WRITE !
- +21 IF '$GET(^TMP($JOB,"RC_REVIEW"))
- GOTO REVIEWQ
- +22 ;
- +23 DO SEL^RCDPEWL(.RCDA)
- +24 SET RCZ=+$ORDER(RCDA(0))
- SET RCZ=+$GET(RCDA(RCZ))
- if 'RCZ
- GOTO REVIEWQ
- +25 ;
- +26 SET RCREV=0
- +27 IF '$ORDER(^RCY(344.49,$PIECE(RCIENS,U),1,"AC",DUZ,RCZ,0))
- Begin DoDot:1
- +28 SET RCREV=$$NEWREV($PIECE(RCIENS,U),RCZ,DUZ)
- End DoDot:1
- +29 IF '$TEST
- Begin DoDot:1
- +30 NEW DIR,X,Y
- +31 SET DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: "
- SET DIR("B")="ADD"
- SET DIR(0)="SA^A:ADD;E:EDIT"
- WRITE !
- DO ^DIR
- KILL DIR
- +32 IF $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +33 ;
- +34 ; Edit a review entry entered by same user
- IF Y="E"
- Begin DoDot:2
- +35 NEW DA,DR,DIE,X,Y
- +36 SET DA(1)=$PIECE(RCIENS,U)
- SET DA=RCZ
- SET DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I $P(^(0),U,2)=DUZ"
- DO ^DIC
- +37 SET RCREV=$SELECT(Y>0:+Y,1:0)
- +38 IF RCREV
- SET DA(2)=$PIECE(RCIENS,U)
- SET DA(1)=RCZ
- SET DA=RCREV
- SET DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
- SET DR=".03;.04////^S X=$$NOW^XLFDT()"
- DO ^DIE
- End DoDot:2
- QUIT
- +39 ;
- +40 SET RCREV=$$NEWREV($PIECE(RCIENS,U),RCZ,DUZ)
- End DoDot:1
- +41 ;
- +42 IF RCREV
- SET DIE("NO^")=""
- SET DA(1)=$PIECE(RCIENS,U)
- SET DA=RCZ
- SET DIE="^RCY(344.49,"_DA(1)_",1,"
- SET DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20"
- DO ^DIE
- KILL DIE
- +43 DO INIT^RCDPEAA2(RCIENS)
- +44 SET REVCHG=""
- +45 ;
- REVIEWQ IF $GET(REVCHG)
- DO INIT^RCDPEAA2(RCIENS)
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
- +1 ; RCSCR = ien of entry in file 344.49
- +2 ; RCZ = ien of the EEOB (seq #)
- +3 ; RCDUZ =DUZ of user entering the comment
- +4 ; Function returns 0 if no new comment, ien of comment if added
- +5 NEW DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
- +6 SET RCNOW=$$NOW^XLFDT()
- WRITE !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
- +7 SET DA(2)=RCSCR
- SET DA(1)=RCZ
- SET X=RCNOW
- SET DIC("DR")=".02////"_RCDUZ_";.03"
- SET DLAYGO=344.492
- SET DIC(0)="L"
- +8 SET DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
- +9 KILL DO,DD
- +10 DO FILE^DICN
- KILL DO,DD,DIC,DLAYGO
- +11 SET RCREV=+Y
- +12 IF RCREV'>0
- SET RCREV=0
- GOTO NEWREVQ
- +13 ; No comment - delete entry
- IF '$ORDER(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0))
- SET DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
- SET DA=RCREV
- DO ^DIK
- SET RCREV=0
- +14 ;
- NEWREVQ QUIT RCREV
- +1 ;
- ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
- +1 ; RCSCR = ien of entry in file 344.49
- +2 ; RCDUZ = the ien of the user
- +3 NEW DIC,DA,X,Y,DLAYGO,DO,DD
- +4 SET Y=+$ORDER(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
- +5 IF Y
- GOTO ADDUQ
- +6 SET DLAYGO=344.492
- SET DA(1)=RCSCR
- SET DIC(0)="L"
- SET X=RCDUZ
- SET DIC="^RCY(344.49,"_DA(1)_",2,"
- SET DIC("DR")=".02////0;.03////N"
- +7 DO FILE^DICN
- KILL DIC,DLAYGO
- ADDUQ QUIT $SELECT(Y>0:Y,1:0)
- +1 ;
- PREOB(RCIENS) ; Print/View EOB detail
- +1 NEW RCDA,RCDAZ,Z,Z0
- +2 DO FULL^VALM1
- +3 SET RCDA=$PIECE($GET(^RCY(344.49,$PIECE(RCIENS,U),1,$PIECE(RCIENS,U,2),0)),U,9)
- +4 FOR RCDAZ=1:1:$LENGTH(RCDA,",")
- SET RCDAZ(RCDAZ)=$PIECE(RCDA,",",RCDAZ)
- +5 SET Z=0
- FOR
- SET Z=$ORDER(RCDAZ(Z))
- if 'Z
- QUIT
- Begin DoDot:1
- +6 ;
- +7 SET Z0=RCDAZ(Z)
- +8 IF $EXTRACT(Z0,1,3)="ADJ"
- Begin DoDot:2
- +9 IF $GET(^RCY(344.4,RCSCR,2,+$PIECE(Z0,"ADJ",2),0))'=""
- SET RCDAZ(Z)="ADJ^"_+$PIECE(Z0,"ADJ",2)
- End DoDot:2
- QUIT
- +10 ;
- +11 SET Z0=$GET(^RCY(344.4,$PIECE(RCIENS,U),1,+Z0,0))
- +12 SET RCDAZ(Z)=+Z0_U_$SELECT($PIECE(Z0,U,2):$PIECE(Z0,U,2),1:-1)
- QUIT
- End DoDot:1
- +13 ;
- +14 DO VP^RCDPEWL2($PIECE(RCIENS,U),.RCDAZ)
- +15 ;
- +16 SET VALMBCK="R"
- +17 QUIT
- +18 ;
- VERIF(RCIENS) ;EP - Protocol action RCDPE APAR VERIFY
- +1 ; Entry point to verification options on APAR worklist
- +2 ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
- +3 ; 344.491^selectable line item from listman screen
- +4 NEW DIR,DIRUT,DTOUT,DUOUT,RCQUIT,X,Y
- +5 DO FULL^VALM1
- +6 ; PRCA*4.5*318 Added security key check
- IF '$DATA(^XUSEC("RCDPEPP",DUZ))
- Begin DoDot:1
- +7 SET VALMBCK="R"
- +8 WRITE !!,"This action can only be taken by users that have the RCDPEPP security key.",!
- +9 DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +10 ;
- +11 WRITE !!!!
- +12 SET RCQUIT=0
- +13 FOR
- Begin DoDot:1
- +14 SET DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
- +15 SET DIR("A",1)="VERIFY EEOBs:"
- +16 SET DIR("A",2)=" 1 MANUALLY MARK AS VERIFIED"
- +17 SET DIR("A",3)=" 2 REPORT OF UNVERIFIED WITH DISCREPANCIES"
- +18 SET DIR("A",4)=" 3 QUIT AND RETURN TO WORKLIST"
- +19 SET DIR("A")="Select Action: "
- SET DIR("B")="QUIT"
- WRITE !
- DO ^DIR
- KILL DIR
- +20 IF Y=3!(Y="")!$DATA(DUOUT)!$DATA(DTOUT)
- SET RCQUIT=1
- QUIT
- +21 ;
- +22 IF Y=1
- DO MVER($PIECE(RCIENS,U))
- WRITE !!
- QUIT
- +23 ;
- +24 IF Y=2
- DO RPT^RCDPEV0($PIECE(RCIENS,U))
- WRITE !!
- QUIT
- End DoDot:1
- if RCQUIT
- QUIT
- +25 ;
- +26 SET VALMBCK="R"
- +27 QUIT
- +28 ;
- MVER(RCERA) ; Manually mark an EEOB as verified within APAR
- +1 ; subroutine cloned from the process that VERIFIES EEOBs off the standard worklist (MVER^RCDPEV)
- +2 ; but with specific changes to support APAR
- +3 ; this subroutine only needs to VERIFY one EEOB rather than a list of EEOBs
- +4 NEW A,CT,DA,DIE,DR,DTOUT,DUOUT,Z,Z0,Z1,RCT,RCY,RCY0,RCZ0,RCLINE,RCYNUM,DIR,X,Y,RESULT,SPLIT,Q,Q0,DT1,DT2
- +5 NEW VERIFIED
- +6 SET (VERIFIED,RCT)=0
- SET CT=1
- SET Z0=""
- +7 ; get the EEOB entry ien to determine if already it's already been verified
- +8 SET Z1=$ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,""))
- IF Z1
- SET Z=^TMP("RCDPE-EOB_WLDX",$JOB,Z1)
- +9 ; grab the data belonging to the EEOB
- +10 IF Z]""
- SET Z0=$GET(^RCY(344.49,RCERA,1,+$PIECE(Z,U,2),0))
- +11 ; get VERIFY data
- +12 IF Z0'=""
- IF $PIECE(Z0,U,13)
- SET VERIFIED=1
- +13 IF VERIFIED
- Begin DoDot:1
- +14 SET DIR(0)="EA"
- SET DIR("A",1)="THIS EEOB IS ALREADY VERIFIED"
- SET DIR("A")="PRESS RETURN TO CONTINUE: "
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +15 SET RCY=+$PIECE($GET(^TMP("RCDPE-EOB_WLDX",$JOB,Z1)),U,2)
- SET RCLINE=+^(Z1)
- SET RCYNUM=Z1
- +16 SET RCY0=$GET(^RCY(344.49,RCERA,1,RCY,0))
- +17 SET RCZ0=$GET(^RCY(344.4,RCERA,1,+$PIECE(RCY0,U,9),0))
- +18 IF '$PIECE(RCZ0,U,2)
- Begin DoDot:1
- +19 WRITE !!,"THIS LINE DOES NOT REFERENCE A VALID BILL"
- End DoDot:1
- +20 IF '$TEST
- Begin DoDot:1
- +21 SET RESULT=$$VER^RCDPEV(RCERA,+$GET(^IBM(361.1,+$PIECE(RCZ0,U,2),0)),+$PIECE(RCY0,U,9),1)
- +22 FOR Z=2:1:9
- IF $EXTRACT($PIECE(RESULT,U,Z))="*"
- SET Q=$PIECE(RESULT,U,Z)
- SET $EXTRACT(Q,1)=""
- SET $PIECE(RESULT,U,Z)=Q
- +23 SET SPLIT=$ORDER(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001")
- +24 SET Z=$SELECT(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ")
- +25 SET Z=Z_$PIECE(RCY0,U,2)_$SELECT('SPLIT:"",1:" (ORIGINAL ERA DATA)")
- +26 IF SPLIT
- Begin DoDot:2
- +27 SET Q=+RCY0
- FOR
- SET Q=$ORDER(^RCY(344.49,RCERA,1,"B",Q))
- if (Q\1)'=+RCY0
- QUIT
- SET Q0=+$ORDER(^RCY(344.49,RCERA,1,"B",Q,0))
- SET Q0=$GET(^RCY(344.49,RCERA,1,Q0,0))
- IF $PIECE(Q0,U,2)'=""
- SET Z=Z_" "_$PIECE(Q0,U,2)
- End DoDot:2
- +28 WRITE !!!,Z
- +29 WRITE !,?13,"PATIENT NAME"_$JUSTIFY("",18)_" SUBMITTED AMT SVC DATE(S)"
- +30 WRITE !,?13,"------------------------------ --------------- -----------------"
- +31 SET DT1=$EXTRACT($SELECT($PIECE(RESULT,U,7):$$FMTE^XLFDT($PIECE(RESULT,U,7),"2D"),1:"NOTFOUND")_$JUSTIFY("",8),1,8)
- +32 SET DT2=$EXTRACT($SELECT($PIECE(RESULT,U,9):"-"_$$FMTE^XLFDT($PIECE(RESULT,U,9),"2D"),1:"-NOTFOUND")_$JUSTIFY("",9),1,9)
- +33 WRITE !," ERA DATA: ",$EXTRACT($PIECE(RESULT,U,3)_$JUSTIFY("",30),1,30)," ",$EXTRACT($JUSTIFY($PIECE(RESULT,U,5),"",2)_$JUSTIFY("",15),1,15)_" "_DT1_DT2
- +34 WRITE !,?15,$PIECE($GET(^RCY(344,RCERA,0)),U,6)
- +35 SET DT1=$EXTRACT($SELECT($PIECE(RESULT,U,6):$$FMTE^XLFDT($PIECE(RESULT,U,6),"2D"),1:"NOTFOUND")_$JUSTIFY("",8),1,8)
- +36 SET DT2=$EXTRACT($SELECT($PIECE(RESULT,U,8):"-"_$$FMTE^XLFDT($PIECE(RESULT,U,8),"2D"),1:"-NOTFOUND")_$JUSTIFY("",9),1,9)
- +37 WRITE !," BILL DATA: "_$EXTRACT($PIECE(RESULT,U,2)_$JUSTIFY("",30),1,30)_" "_$EXTRACT($JUSTIFY($PIECE(RESULT,U,4),"",2)_$JUSTIFY("",15),1,15)_" "_DT1_DT2
- +38 WRITE !,?15,$PIECE($GET(^DIC(36,+$PIECE(RCZ0,U,4),0)),U),!
- End DoDot:1
- +39 SET DIR(0)="YA"
- SET DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? "
- SET DIR("B")="NO"
- WRITE !
- DO ^DIR
- KILL DIR
- +40 ;
- +41 IF Y'=1
- QUIT
- +42 SET DA(1)=RCERA
- SET DA=+RCY
- SET DIE="^RCY(344.49,"_DA(1)_",1,"
- SET DR=".13////1"
- DO ^DIE
- +43 SET A=$$TOPLINE^RCDPEWL1($GET(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM)
- +44 SET ^TMP("RCDPE-EOB_WL",$JOB,RCLINE,0)=A
- +45 QUIT
- +46 ;
- +47 ;PRCA*4.5*304 - add a claim comment to the ERA detail line from APAR
- COMNT ;
- +1 NEW IEN,SEQ,DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,ZDA,ZBILL,RCOMMENT,TCOMM
- +2 SET RCOMMENT=0
- +3 SET IEN=+$PIECE(RCIENS,U,1)
- +4 ; Validate the selection
- +5 IF IEN=0
- Begin DoDot:1
- +6 WRITE !,"Cannot comment, no record in file ELECTRONIC REMITTANCE ADVICE file selected."
- DO WAIT^VALM1
- End DoDot:1
- GOTO COMQ
- +7 ; Just grab the first sequence number for the comment.
- SET SEQ=$PIECE(^RCY(344.49,IEN,1,+$PIECE(RCIENS,U,2),0),U,9)
- +8 IF $GET(SEQ)=""
- Begin DoDot:1
- +9 WRITE !,"Cannot comment, no ERA detail record selected."
- DO WAIT^VALM1
- End DoDot:1
- GOTO COMQ
- +10 IF $GET(^RCY(344.4,IEN,1,SEQ,0))']""
- Begin DoDot:1
- +11 WRITE !,"Cannot comment, ERA detail record selected not found."
- DO WAIT^VALM1
- End DoDot:1
- GOTO COMQ
- +12 ;
- +13 ; Allow user to put comment on this ERA Detail record
- +14 SET ZDA=SEQ
- SET ZDA(1)=IEN
- SET ZBILL=$PIECE($$GETBILL^RCDPESR0(.ZDA),"-",2)
- +15 WRITE !,"Enter a comment on ERA #"_IEN_" ERA Detail Seq #",SEQ," Bill #",ZBILL,!
- +16 SET DIE="^RCY(344.4,"_IEN_",1,"
- SET DA=SEQ
- SET DA(1)=IEN
- SET DR="4Comment"
- DO ^DIE
- if $DATA(DTOUT)!$DATA(Y)
- GOTO COMQ
- +17 ; Now file user (DUZ) and DATE
- +18 KILL DR
- +19 ; If DA is not defined then the user deleted the comment with an @,
- +20 ; Delete the user and date too.
- +21 SET TCOMM=$$GET1^DIQ(344.41,SEQ_","_IEN_",",4,"E")
- +22 IF TCOMM=""
- SET DA=SEQ
- SET DA(1)=IEN
- SET DR="4.01////@;4.02////@;"
- +23 IF '$TEST
- SET DR="4.01////"_$$DT^XLFDT_";4.02////"_$G(DUZ)_";"
- +24 DO ^DIE
- +25 SET RCOMMENT=1
- +26 DO WAIT^VALM1
- +27 ;
- COMQ ;
- IF RCOMMENT
- DO INIT^RCDPEAA2(RCIENS)
- +1 SET VALMBCK="R"
- +2 QUIT