- RCDPEV ;ALB/TMK - EDI LOCKBOX WORKLIST VERIFY PAYMENTS ;Sep 15, 2014@14:36:22
- ;;4.5;Accounts Receivable;**208,138,298,345**;Mar 20, 1995;Build 34
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- AUTOVER(RCSCR) ; Entrypoint to auto-verify an ERA worklist
- ; RCSCR = ien of the ERA worklist entry in file 344.49
- N Z,Z0,Z00,RC399,RC430,RC3444,RC36112,X,X1,X2,X12,DA,DR,DIE
- S Z=0 F S Z=$O(^RCY(344.49,Z)) Q:'Z S Z0=0 F S Z0=$O(^RCY(344.49,Z,1,Z0)) Q:'Z0 I $P($G(^(Z0,0)),U,7) S Z00=$G(^(0)) D
- . I $$VER(RCSCR,+$P(Z00,U,7),+$P(Z00,U,9)) S DA(1)=RCSCR,DA=Z0,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".13////1" D ^DIE
- ;
- Q
- ;
- VER(RCSCR,RCBILL,RCREF,F1) ; Run verif for WL entry RCSCR in file 344.49
- ; RCBILL = ien of claim in file 430
- ; RCREF = the entry referenced in subfile file 344.41
- ; F1 = flag if set = 1 will return all data, regardless of if it
- ; matches or not. If flag is set to 1 and data doesn't match,
- ; an asterisk (*) will preceed the actual data value in the
- ; corresponding piece
- ; Function returns the following data:
- ; '^' piece 1: 1 if verfied OK 0 if not
- ; '^' piece 2: patient name from VistA if mismatch
- ; '^' piece 3: patient name from EEOB if mismatch
- ; '^' piece 4: amt billed from VistA if mismatch
- ; '^' piece 5: amt billed from EEOB if mismatch
- ; '^' piece 6: date of service 'from' from VistA if mismatch
- ; '^' piece 7: date of service 'from' from EEOB if mismatch
- ; '^' piece 8: date of service 'to' from VistA if mismatch
- ; '^' piece 9: date of service 'to' from EEOB if mismatch
- ; '^' piece 10: patient SSN from VistA
- ;
- N RESULT,SETF1,RC430,RC399,RC3444,RC36112,X,X1,X2,X12,NM,NM1,DTOK,SSN,RC43013
- S RESULT=1,SETF1=$S($G(F1):"*",1:"")
- S RC430=$G(^PRCA(430,RCBILL,0)),RC43013=$G(^(13))
- S RC399=$G(^DGCR(399,RCBILL,0))
- S RC3444=$G(^RCY(344.4,RCSCR,1,RCREF,0))
- S RC36112=$G(^IBM(361.1,+$P(RC3444,U,2),2))
- ;
- S NM=$P($G(^DPT(+$P(RC399,U,2),0)),U),X=$E($P(NM,","),1,5) ; Name from VistA
- S SSN=$P($G(^DPT(+$P(RC399,U,2),0)),U,9)
- S NM1=$P(RC3444,U,15),X1=$E($P(NM1,","),1,5) ; from EEOB
- S X=$$UP^XLFSTR(X),X1=$$UP^XLFSTR(X1) ; prca*4.5*298 verification cannot be case sensitive
- I $G(F1),X1=X S $P(RESULT,U,2)=NM,$P(RESULT,U,3)=NM1
- I X1'=X S $P(RESULT,U)=0,$P(RESULT,U,2)=SETF1_NM,$P(RESULT,U,3)=SETF1_NM1
- ;
- S X=$P(RC430,U,3)+$P(RC43013,U)+$P(RC43013,U,2) ; Amount billed from VistA (including MRA totals)
- S X1=$P(RC36112,U,4) ; from EEOB
- I $G(F1),+X=+X1 S $P(RESULT,U,4)=X,$P(RESULT,U,5)=X1
- ; I +X'=+X1 S $P(RESULT,U)=0,$P(RESULT,U,4)=SETF1_X,$P(RESULT,U,5)=SETF1_X1
- I +X'=+X1 S $P(RESULT,U,4)=SETF1_X,$P(RESULT,U,5)=SETF1_X1 ; PRCA*4.5*345 - Allow line to verify even if billed amount does not match
- ;
- S X=$P($G(^DGCR(399,+RCBILL,"U")),U) ; Date of service from VistA
- S X2=$P($G(^DGCR(399,+RCBILL,"U")),U,2)
- S X1=$P($G(^IBM(361.1,+$P(RC3444,U,2),1)),U,10) ; from EEOB
- S X12=$P($G(^IBM(361.1,+$P(RC3444,U,2),1)),U,11)
- ; if no date of service on EEOB, skip the check
- ; Date of svc on EEOB must fall into date range for svc dates in VistA
- S DTOK=0
- I X1 D
- . I X1=X S DTOK=1
- . I 'DTOK,X1>X S:X1'>X2 DTOK=1
- . I 'DTOK,X1<X S:X12'<X DTOK=1
- . I 'DTOK S $P(RESULT,U)=0,$P(RESULT,U,6)=SETF1_X,$P(RESULT,U,7)=SETF1_X1,$P(RESULT,U,8)=SETF1_X2,$P(RESULT,U,9)=SETF1_X12 Q
- I DTOK,$G(F1) S $P(RESULT,U,6)=X,$P(RESULT,U,7)=X1,$P(RESULT,U,8)=X2,$P(RESULT,U,9)=X12
- S $P(RESULT,U,10)=SSN
- ;
- VERQ Q RESULT
- ;
- MVER(RCERA) ; Manually mark an EEOB as verified
- 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
- S RCT=0,CT=1
- F Z1=1:1 S Z=$G(^TMP("RCDPE-EOB_WLDX",$J,Z1)) Q:Z="" Q:CT'<100 S Z0=$G(^RCY(344.49,RCERA,1,+$P(Z,U,2),0)) I Z0'="",'$P(Z0,U,13) S RCT=RCT+1 D Q:CT'<100
- . S CT=CT+1 I CT<100 D Q
- .. S:RCT=1 RCT(1)=Z1
- .. S DIR("?",CT)=" "_$G(^TMP("RCDPE-EOB_WL",$J,+Z,0)),CT=CT+1,DIR("?",CT)=$J("",10)_$P(Z0,U,2)
- .. S Q=+Z0
- .. I $O(^RCY(344.49,RCERA,1,"B",Q_".9999"),-1)'=(Q_".001")
- .. I $O(^RCY(344.49,RCERA,1,"B",Q_".9999"),-1)'=(Q_".001") S DIR("?",CT)=DIR("?",CT)_" (LINE HAS BEEN SPLIT)"
- . K DIR("?")
- ;
- I 'RCT D Q
- . S DIR(0)="EA",DIR("A",1)="ALL EEOBS HAVE ALREADY BEEN VERIFIED IN THIS "_$S($G(^TMP("RCBATCH_SELECTED",$J)):"BATCH",1:"ERA"),DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
- ;
- I RCT<100 S DIR("?",1)="THE FOLLOWING EEOB LINE(S) "_$S($G(^TMP("RCBATCH_SELECTED",$J)):"IN THIS BATCH ",1:"")_"ARE NOT VERIFIED"
- I RCT'<100 S DIR("?",1)="THERE ARE TOO MANY EEOB ENTRIES NOT VERIFIED TO LIST",DIR("?",2)="PRINT THE UNVERIFIED DISCREPANCY REPORT TO GET A LIST OF POSSIBLE CHOICES"
- S DIR("?")=" "
- S DIR(0)="NA^1:"_($O(^TMP("RCDPE-EOB_WLDX",$J,""),-1)\1),DIR("A")="SELECT AN EEOB LINE TO MARK AS VERIFIED: "
- I RCT=1 S DIR("B")=RCT(1)
- W ! D ^DIR K DIR
- I $D(DUOUT)!$D(DTOUT)!(Y="") Q
- I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !,"THIS LINE DOES NOT EXIST FOR THIS ERA" W ! Q
- S RCY=+$P($G(^TMP("RCDPE-EOB_WLDX",$J,Y)),U,2),RCLINE=+^(Y),RCYNUM=+Y
- S RCY0=$G(^RCY(344.49,RCERA,1,RCY,0))
- I $P(RCY0,U,13) D Q
- . S DIR(0)="EA",DIR("A",1)="THIS LINE IS ALREADY VERIFIED",DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
- 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(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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEV 7068 printed Feb 18, 2025@23:11:59 Page 2
- RCDPEV ;ALB/TMK - EDI LOCKBOX WORKLIST VERIFY PAYMENTS ;Sep 15, 2014@14:36:22
- +1 ;;4.5;Accounts Receivable;**208,138,298,345**;Mar 20, 1995;Build 34
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- AUTOVER(RCSCR) ; Entrypoint to auto-verify an ERA worklist
- +1 ; RCSCR = ien of the ERA worklist entry in file 344.49
- +2 NEW Z,Z0,Z00,RC399,RC430,RC3444,RC36112,X,X1,X2,X12,DA,DR,DIE
- +3 SET Z=0
- FOR
- SET Z=$ORDER(^RCY(344.49,Z))
- if 'Z
- QUIT
- SET Z0=0
- FOR
- SET Z0=$ORDER(^RCY(344.49,Z,1,Z0))
- if 'Z0
- QUIT
- IF $PIECE($GET(^(Z0,0)),U,7)
- SET Z00=$GET(^(0))
- Begin DoDot:1
- +4 IF $$VER(RCSCR,+$PIECE(Z00,U,7),+$PIECE(Z00,U,9))
- SET DA(1)=RCSCR
- SET DA=Z0
- SET DIE="^RCY(344.49,"_DA(1)_",1,"
- SET DR=".13////1"
- DO ^DIE
- End DoDot:1
- +5 ;
- +6 QUIT
- +7 ;
- VER(RCSCR,RCBILL,RCREF,F1) ; Run verif for WL entry RCSCR in file 344.49
- +1 ; RCBILL = ien of claim in file 430
- +2 ; RCREF = the entry referenced in subfile file 344.41
- +3 ; F1 = flag if set = 1 will return all data, regardless of if it
- +4 ; matches or not. If flag is set to 1 and data doesn't match,
- +5 ; an asterisk (*) will preceed the actual data value in the
- +6 ; corresponding piece
- +7 ; Function returns the following data:
- +8 ; '^' piece 1: 1 if verfied OK 0 if not
- +9 ; '^' piece 2: patient name from VistA if mismatch
- +10 ; '^' piece 3: patient name from EEOB if mismatch
- +11 ; '^' piece 4: amt billed from VistA if mismatch
- +12 ; '^' piece 5: amt billed from EEOB if mismatch
- +13 ; '^' piece 6: date of service 'from' from VistA if mismatch
- +14 ; '^' piece 7: date of service 'from' from EEOB if mismatch
- +15 ; '^' piece 8: date of service 'to' from VistA if mismatch
- +16 ; '^' piece 9: date of service 'to' from EEOB if mismatch
- +17 ; '^' piece 10: patient SSN from VistA
- +18 ;
- +19 NEW RESULT,SETF1,RC430,RC399,RC3444,RC36112,X,X1,X2,X12,NM,NM1,DTOK,SSN,RC43013
- +20 SET RESULT=1
- SET SETF1=$SELECT($GET(F1):"*",1:"")
- +21 SET RC430=$GET(^PRCA(430,RCBILL,0))
- SET RC43013=$GET(^(13))
- +22 SET RC399=$GET(^DGCR(399,RCBILL,0))
- +23 SET RC3444=$GET(^RCY(344.4,RCSCR,1,RCREF,0))
- +24 SET RC36112=$GET(^IBM(361.1,+$PIECE(RC3444,U,2),2))
- +25 ;
- +26 ; Name from VistA
- SET NM=$PIECE($GET(^DPT(+$PIECE(RC399,U,2),0)),U)
- SET X=$EXTRACT($PIECE(NM,","),1,5)
- +27 SET SSN=$PIECE($GET(^DPT(+$PIECE(RC399,U,2),0)),U,9)
- +28 ; from EEOB
- SET NM1=$PIECE(RC3444,U,15)
- SET X1=$EXTRACT($PIECE(NM1,","),1,5)
- +29 ; prca*4.5*298 verification cannot be case sensitive
- SET X=$$UP^XLFSTR(X)
- SET X1=$$UP^XLFSTR(X1)
- +30 IF $GET(F1)
- IF X1=X
- SET $PIECE(RESULT,U,2)=NM
- SET $PIECE(RESULT,U,3)=NM1
- +31 IF X1'=X
- SET $PIECE(RESULT,U)=0
- SET $PIECE(RESULT,U,2)=SETF1_NM
- SET $PIECE(RESULT,U,3)=SETF1_NM1
- +32 ;
- +33 ; Amount billed from VistA (including MRA totals)
- SET X=$PIECE(RC430,U,3)+$PIECE(RC43013,U)+$PIECE(RC43013,U,2)
- +34 ; from EEOB
- SET X1=$PIECE(RC36112,U,4)
- +35 IF $GET(F1)
- IF +X=+X1
- SET $PIECE(RESULT,U,4)=X
- SET $PIECE(RESULT,U,5)=X1
- +36 ; I +X'=+X1 S $P(RESULT,U)=0,$P(RESULT,U,4)=SETF1_X,$P(RESULT,U,5)=SETF1_X1
- +37 ; PRCA*4.5*345 - Allow line to verify even if billed amount does not match
- IF +X'=+X1
- SET $PIECE(RESULT,U,4)=SETF1_X
- SET $PIECE(RESULT,U,5)=SETF1_X1
- +38 ;
- +39 ; Date of service from VistA
- SET X=$PIECE($GET(^DGCR(399,+RCBILL,"U")),U)
- +40 SET X2=$PIECE($GET(^DGCR(399,+RCBILL,"U")),U,2)
- +41 ; from EEOB
- SET X1=$PIECE($GET(^IBM(361.1,+$PIECE(RC3444,U,2),1)),U,10)
- +42 SET X12=$PIECE($GET(^IBM(361.1,+$PIECE(RC3444,U,2),1)),U,11)
- +43 ; if no date of service on EEOB, skip the check
- +44 ; Date of svc on EEOB must fall into date range for svc dates in VistA
- +45 SET DTOK=0
- +46 IF X1
- Begin DoDot:1
- +47 IF X1=X
- SET DTOK=1
- +48 IF 'DTOK
- IF X1>X
- if X1'>X2
- SET DTOK=1
- +49 IF 'DTOK
- IF X1<X
- if X12'<X
- SET DTOK=1
- +50 IF 'DTOK
- SET $PIECE(RESULT,U)=0
- SET $PIECE(RESULT,U,6)=SETF1_X
- SET $PIECE(RESULT,U,7)=SETF1_X1
- SET $PIECE(RESULT,U,8)=SETF1_X2
- SET $PIECE(RESULT,U,9)=SETF1_X12
- QUIT
- End DoDot:1
- +51 IF DTOK
- IF $GET(F1)
- SET $PIECE(RESULT,U,6)=X
- SET $PIECE(RESULT,U,7)=X1
- SET $PIECE(RESULT,U,8)=X2
- SET $PIECE(RESULT,U,9)=X12
- +52 SET $PIECE(RESULT,U,10)=SSN
- +53 ;
- VERQ QUIT RESULT
- +1 ;
- MVER(RCERA) ; Manually mark an EEOB as verified
- +1 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
- +2 SET RCT=0
- SET CT=1
- +3 FOR Z1=1:1
- SET Z=$GET(^TMP("RCDPE-EOB_WLDX",$JOB,Z1))
- if Z=""
- QUIT
- if CT'<100
- QUIT
- SET Z0=$GET(^RCY(344.49,RCERA,1,+$PIECE(Z,U,2),0))
- IF Z0'=""
- IF '$PIECE(Z0,U,13)
- SET RCT=RCT+1
- Begin DoDot:1
- +4 SET CT=CT+1
- IF CT<100
- Begin DoDot:2
- +5 if RCT=1
- SET RCT(1)=Z1
- +6 SET DIR("?",CT)=" "_$GET(^TMP("RCDPE-EOB_WL",$JOB,+Z,0))
- SET CT=CT+1
- SET DIR("?",CT)=$JUSTIFY("",10)_$PIECE(Z0,U,2)
- +7 SET Q=+Z0
- +8 IF $ORDER(^RCY(344.49,RCERA,1,"B",Q_".9999"),-1)'=(Q_".001")
- +9 IF $ORDER(^RCY(344.49,RCERA,1,"B",Q_".9999"),-1)'=(Q_".001")
- SET DIR("?",CT)=DIR("?",CT)_" (LINE HAS BEEN SPLIT)"
- End DoDot:2
- QUIT
- +10 KILL DIR("?")
- End DoDot:1
- if CT'<100
- QUIT
- +11 ;
- +12 IF 'RCT
- Begin DoDot:1
- +13 SET DIR(0)="EA"
- SET DIR("A",1)="ALL EEOBS HAVE ALREADY BEEN VERIFIED IN THIS "_$SELECT($GET(^TMP("RCBATCH_SELECTED",$JOB)):"BATCH",1:"ERA")
- SET DIR("A")="PRESS RETURN TO CONTINUE: "
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +14 ;
- +15 IF RCT<100
- SET DIR("?",1)="THE FOLLOWING EEOB LINE(S) "_$SELECT($GET(^TMP("RCBATCH_SELECTED",$JOB)):"IN THIS BATCH ",1:"")_"ARE NOT VERIFIED"
- +16 IF RCT'<100
- SET DIR("?",1)="THERE ARE TOO MANY EEOB ENTRIES NOT VERIFIED TO LIST"
- SET DIR("?",2)="PRINT THE UNVERIFIED DISCREPANCY REPORT TO GET A LIST OF POSSIBLE CHOICES"
- +17 SET DIR("?")=" "
- +18 SET DIR(0)="NA^1:"_($ORDER(^TMP("RCDPE-EOB_WLDX",$JOB,""),-1)\1)
- SET DIR("A")="SELECT AN EEOB LINE TO MARK AS VERIFIED: "
- +19 IF RCT=1
- SET DIR("B")=RCT(1)
- +20 WRITE !
- DO ^DIR
- KILL DIR
- +21 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
- QUIT
- +22 IF '$DATA(^TMP("RCDPE-EOB_WLDX",$JOB,Y))
- WRITE !,"THIS LINE DOES NOT EXIST FOR THIS ERA"
- WRITE !
- QUIT
- +23 SET RCY=+$PIECE($GET(^TMP("RCDPE-EOB_WLDX",$JOB,Y)),U,2)
- SET RCLINE=+^(Y)
- SET RCYNUM=+Y
- +24 SET RCY0=$GET(^RCY(344.49,RCERA,1,RCY,0))
- +25 IF $PIECE(RCY0,U,13)
- Begin DoDot:1
- +26 SET DIR(0)="EA"
- SET DIR("A",1)="THIS LINE IS ALREADY VERIFIED"
- SET DIR("A")="PRESS RETURN TO CONTINUE: "
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +27 SET RCZ0=$GET(^RCY(344.4,RCERA,1,+$PIECE(RCY0,U,9),0))
- +28 IF '$PIECE(RCZ0,U,2)
- Begin DoDot:1
- +29 WRITE !!,"THIS LINE DOES NOT REFERENCE A VALID BILL"
- End DoDot:1
- +30 IF '$TEST
- Begin DoDot:1
- +31 SET RESULT=$$VER(RCERA,+$GET(^IBM(361.1,+$PIECE(RCZ0,U,2),0)),+$PIECE(RCY0,U,9),1)
- +32 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
- +33 SET SPLIT=$ORDER(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001")
- +34 SET Z=$SELECT(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ")
- +35 SET Z=Z_$PIECE(RCY0,U,2)_$SELECT('SPLIT:"",1:" (ORIGINAL ERA DATA)")
- +36 IF SPLIT
- Begin DoDot:2
- +37 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
- +38 WRITE !!!,Z
- +39 WRITE !,?13,"PATIENT NAME"_$JUSTIFY("",18)_" SUBMITTED AMT SVC DATE(S)"
- +40 WRITE !,?13,"------------------------------ --------------- -----------------"
- +41 SET DT1=$EXTRACT($SELECT($PIECE(RESULT,U,7):$$FMTE^XLFDT($PIECE(RESULT,U,7),"2D"),1:"NOTFOUND")_$JUSTIFY("",8),1,8)
- +42 SET DT2=$EXTRACT($SELECT($PIECE(RESULT,U,9):"-"_$$FMTE^XLFDT($PIECE(RESULT,U,9),"2D"),1:"-NOTFOUND")_$JUSTIFY("",9),1,9)
- +43 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
- +44 WRITE !,?15,$PIECE($GET(^RCY(344,RCERA,0)),U,6)
- +45 SET DT1=$EXTRACT($SELECT($PIECE(RESULT,U,6):$$FMTE^XLFDT($PIECE(RESULT,U,6),"2D"),1:"NOTFOUND")_$JUSTIFY("",8),1,8)
- +46 SET DT2=$EXTRACT($SELECT($PIECE(RESULT,U,8):"-"_$$FMTE^XLFDT($PIECE(RESULT,U,8),"2D"),1:"-NOTFOUND")_$JUSTIFY("",9),1,9)
- +47 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
- +48 WRITE !,?15,$PIECE($GET(^DIC(36,+$PIECE(RCZ0,U,4),0)),U),!
- End DoDot:1
- +49 SET DIR(0)="YA"
- SET DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? "
- SET DIR("B")="NO"
- WRITE !
- DO ^DIR
- KILL DIR
- +50 IF Y'=1
- QUIT
- +51 SET DA(1)=RCERA
- SET DA=+RCY
- SET DIE="^RCY(344.49,"_DA(1)_",1,"
- SET DR=".13////1"
- DO ^DIE
- +52 SET A=$$TOPLINE^RCDPEWL1($GET(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM)
- +53 SET ^TMP("RCDPE-EOB_WL",$JOB,RCLINE,0)=A
- +54 QUIT
- +55 ;