- RCDPEM8 ;OIFO-BAYPINES/PJH - EOB MOVE/COPY BULLETINS ;Jun 06, 2014@19:11:19
- ;;4.5;Accounts Receivable;**276,298**;Mar 20, 1995;Build 121
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- EN ; Main entry point for Moved/Copied EOB bulletins
- ;
- ; Integration Agreement IA 451 allows read of file #361.1 from AR
- ;
- N EOBCNT,RCPROG
- ;Clear workfiles
- S RCPROG="RCDPEM8" K ^TMP(RCPROG,$J)
- ;Set count of EOB found
- S EOBCNT=0
- ;
- ;Scan for today's moved/copied EOB's
- D EOBSCAN
- ;-----
- ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
- ;Bulletin
- ;I EOBCNT D BULLETIN
- ;-----
- ;Clear workfiles
- K ^TMP(RCPROG,$J)
- Q
- ;
- EOBSCAN ;Scan EOB
- N CDATE,CNT,DONE,EOBIEN,IEN101,NOW
- ;Start day for scan is yesterday
- S NOW=$$NOW^XLFDT,CDATE=$$FMADD^XLFDT($P(NOW,"."),-1)
- ;Scan AEOB index for changed EOBs
- F S CDATE=$O(^IBM(361.1,"AEOB",CDATE)) Q:'CDATE D
- .;Check if change was over 24 hours ago
- .I $$FMDIFF^XLFDT(NOW,CDATE,2)>86400 Q
- .;Skip this transaction if all referenced claims are active
- .Q:'$$INACTIVE(CDATE)
- .;Otherwise save bulletin details for EOB's in the transaction
- .S EOBIEN="",CNT=0,EOBCNT=EOBCNT+1
- .F S EOBIEN=$O(^IBM(361.1,"AEOB",CDATE,EOBIEN)) Q:'EOBIEN D
- ..;Update counter
- ..S CNT=CNT+1
- ..S IEN101=$O(^IBM(361.1,"AEOB",CDATE,EOBIEN,"")) Q:'IEN101
- ..;Save to workfile
- ..D SAVE(CDATE,EOBIEN,IEN101,EOBCNT,CNT)
- Q
- ;
- INACTIVE(CDATE) ;Search for any bill that is not ACTIVE
- N CBILL,FBILL,FOUND,REC101,SUB,SUB101
- S SUB=0,FOUND=0
- F S SUB=$O(^IBM(361.1,"AEOB",CDATE,SUB)) Q:'SUB D Q:FOUND
- .S SUB101=0
- .F S SUB101=$O(^IBM(361.1,"AEOB",CDATE,SUB,SUB101)) Q:'SUB101 D Q:FOUND
- ..S REC101=$G(^IBM(361.1,SUB,101,SUB101,0))
- ..;From bill
- ..S FBILL=$P(REC101,U,4)
- ..I FBILL S FOUND=$$CHECK(FBILL) Q:FOUND
- ..;Current bill on EOB
- ..S CBILL=$P($G(^IBM(361.1,SUB,0)),U)
- ..;AR claim status
- ..I CBILL S FOUND=$$CHECK(CBILL)
- Q FOUND
- ;
- CHECK(IEN430) ;Check claim status in AR
- I $$GET1^DIQ(430,IEN430,8)="ACTIVE" Q 0
- Q 1
- ;
- SAVE(CDATE,EOBIEN,IEN101,EOBCNT,CNT) ;Put the data into the ^TMP global
- ; INPUTS: EOBIEN = ien of the EOB
- ; IEN101 = ien of individual copy
- ; EOBCNT = count of EOB found
- ; CNT = count of claims within transaction
- ; RETURNS : Builds each entry in the ^TMP global
- ;
- N BIEN,BEXT,DATE,DOS,PATIEN,PATNAM,PIEN,PEXT,PSQ,PSQEXT,REC0,STAT
- N REC101,ORIG,MODE
- ;Get EOB detail
- S REC0=$G(^IBM(361.1,EOBIEN,0))
- ;Bill pointer
- S BIEN=$P(REC0,U) Q:'BIEN
- ;Get audit detail
- S REC101=$G(^IBM(361.1,EOBIEN,101,IEN101,0))
- ;Mode and Original claim
- S ORIG=$P(REC101,U,4),MODE=$P(REC101,U,5)
- ;
- ;If transaction is a move the only EOB is on the new claim
- ;
- ;Create report line for original claim
- I MODE="M",ORIG D
- .N BIEN
- .S BIEN=ORIG D SAVE1 S CNT=CNT+1
- ;
- ;Save transaction for to bill
- D SAVE1
- Q
- ;
- SAVE1 ;Save unformatted bill details into ^TMP
- ;
- ;Get Bill number from bill IEN
- S BEXT=$P($G(^PRCA(430,BIEN,0)),U)
- ;Patient IEN
- S PATIEN=$P($G(^DGCR(399,BIEN,0)),U,2)
- ;Patient Name
- S PATNAM=$$EXTERNAL^DILFD(399,.02,,PATIEN)
- ;DOS
- S DOS=$$FMTE^XLFDT($P($G(^DGCR(399,BIEN,0)),U,3),"2D")
- ;Payer
- S PIEN=$P(REC0,U,2)
- ;Payer external form
- S PEXT=$$EXTERNAL^DILFD(361.1,.02,,PIEN)
- ;If no payer name on EOB check AR claim
- I PEXT="" S PEXT=$$GET1^DIQ(430,BIEN,9)
- ;Truncate payer name to 18 characters
- S PEXT=$E(PEXT,1,18)
- ;Payer Sequence
- S PSQ=$P(REC0,U,15)
- ;Payer sequence - external
- S PSQEXT=$$EXTERNAL^DILFD(361.1,.15,,PSQ)
- ;Display sequence if not null
- S:PSQEXT]"" PEXT=PEXT_"/"_PSQEXT
- ;AR claim status
- S STAT=$$GET1^DIQ(430,BIEN,8)
- ;Date/Time EOB was moved/copied
- S DATE=$$FMTE^XLFDT(CDATE,"2S")
- ;
- S ^TMP(RCPROG,$J,EOBCNT,CNT)=DATE_U_BEXT_U_PATNAM_U_DOS_U_PEXT_U_STAT
- Q
- ;
- BULLETIN ;Create bulletins only if moved/copied EOB found
- ;
- N ARRAY,BLANK,SBJ,SUB,SUBHDR,SUBHDR1,SUBHDR2,CNT,CNT1,RCPROG1,GLB
- N LINE,DET
- S RCPROG1="RCDPEM8A",GLB=$NA(^TMP(RCPROG1,$J,"XMTEXT"))
- ;
- ;Compile Move/Copy Transactions Bulletin
- ;Build header
- K @GLB
- S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-Move/Copy Transactions"
- S @GLB@(1)="The listed Move/Copy transaction(s) were performed within the last 24 hours"
- S @GLB@(2)="and at least one of the claims in each of the transactions was NOT ACTIVE."
- S @GLB@(3)=" "
- S @GLB@(4)="Total # of transactions - "_EOBCNT
- S @GLB@(6)=" "
- S @GLB@(7)="BILL # PATIENT DOS PAYER/SEQUENCE"
- S @GLB@(8)=" STATUS"
- S @GLB@(9)="----------------------------------------------------------------------------"
- ;
- ;Sub headers
- S SUBHDR="Transaction "
- S SUBHDR1=" - 'MOVE/COPY FROM' bill "
- S SUBHDR2=" 'MOVE/COPY TO' bill(s)"
- S BLANK=$J("",75)
- ;
- ;Move EOB search findings into message
- S EOBCNT="",CNT1=9
- F S EOBCNT=$O(^TMP(RCPROG,$J,EOBCNT)) Q:'EOBCNT D
- .S CNT=0
- .F S CNT=$O(^TMP(RCPROG,$J,EOBCNT,CNT)) Q:'CNT D
- ..;EOB data from scan
- ..S DET=$G(^TMP(RCPROG,$J,EOBCNT,CNT))
- ..;Check if 'From' or 'To'
- ..I CNT=1 S LINE=SUBHDR_EOBCNT_SUBHDR1_$P(DET,U)
- ..E S LINE=SUBHDR2
- ..S CNT1=CNT1+1,@GLB@(CNT1)=LINE
- ..S CNT1=CNT1+1,@GLB@(CNT1)=$$EOBL(DET)
- ..S CNT1=CNT1+1,@GLB@(CNT1)=" "_$P(DET,U,6)
- ..S CNT1=CNT1+1,@GLB@(CNT1)=BLANK
- S @GLB@(CNT1+1)="** END OF REPORT **"
- ;
- ;Transmit mail message
- N XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
- S XMDUZ=DUZ,XMTEXT=GLB,XMSUB=SBJ,XMY("I:G.RCDPE MOVE COPY")=""
- S XMINSTR("FROM")="POSTMASTER"
- D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
- K @GLB
- Q
- ;
- ;
- EOBL(DET) ;Format EOB line
- N BILL,DOS,PATIENT,PAYER,OUTPUT,SP
- S BILL=$P(DET,U,2),PATIENT=$P(DET,U,3),DOS=$P(DET,U,4),SP=$J("",80)
- S PAYER=$P(DET,U,5)
- ;Truncate patient name
- S PATIENT=$E(PATIENT,1,19)
- ;Bill number
- S OUTPUT=BILL_$E(SP,1,12-$L(BILL))
- ;Patient
- S OUTPUT=OUTPUT_PATIENT_$E(SP,1,20-$L(PATIENT))
- ;DOS
- S OUTPUT=OUTPUT_DOS_$E(SP,1,13-$L(DOS))
- ;Payer
- S OUTPUT=OUTPUT_PAYER
- ;
- Q OUTPUT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM8 5993 printed Dec 13, 2024@01:44:53 Page 2
- RCDPEM8 ;OIFO-BAYPINES/PJH - EOB MOVE/COPY BULLETINS ;Jun 06, 2014@19:11:19
- +1 ;;4.5;Accounts Receivable;**276,298**;Mar 20, 1995;Build 121
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- EN ; Main entry point for Moved/Copied EOB bulletins
- +1 ;
- +2 ; Integration Agreement IA 451 allows read of file #361.1 from AR
- +3 ;
- +4 NEW EOBCNT,RCPROG
- +5 ;Clear workfiles
- +6 SET RCPROG="RCDPEM8"
- KILL ^TMP(RCPROG,$JOB)
- +7 ;Set count of EOB found
- +8 SET EOBCNT=0
- +9 ;
- +10 ;Scan for today's moved/copied EOB's
- +11 DO EOBSCAN
- +12 ;-----
- +13 ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
- +14 ;Bulletin
- +15 ;I EOBCNT D BULLETIN
- +16 ;-----
- +17 ;Clear workfiles
- +18 KILL ^TMP(RCPROG,$JOB)
- +19 QUIT
- +20 ;
- EOBSCAN ;Scan EOB
- +1 NEW CDATE,CNT,DONE,EOBIEN,IEN101,NOW
- +2 ;Start day for scan is yesterday
- +3 SET NOW=$$NOW^XLFDT
- SET CDATE=$$FMADD^XLFDT($PIECE(NOW,"."),-1)
- +4 ;Scan AEOB index for changed EOBs
- +5 FOR
- SET CDATE=$ORDER(^IBM(361.1,"AEOB",CDATE))
- if 'CDATE
- QUIT
- Begin DoDot:1
- +6 ;Check if change was over 24 hours ago
- +7 IF $$FMDIFF^XLFDT(NOW,CDATE,2)>86400
- QUIT
- +8 ;Skip this transaction if all referenced claims are active
- +9 if '$$INACTIVE(CDATE)
- QUIT
- +10 ;Otherwise save bulletin details for EOB's in the transaction
- +11 SET EOBIEN=""
- SET CNT=0
- SET EOBCNT=EOBCNT+1
- +12 FOR
- SET EOBIEN=$ORDER(^IBM(361.1,"AEOB",CDATE,EOBIEN))
- if 'EOBIEN
- QUIT
- Begin DoDot:2
- +13 ;Update counter
- +14 SET CNT=CNT+1
- +15 SET IEN101=$ORDER(^IBM(361.1,"AEOB",CDATE,EOBIEN,""))
- if 'IEN101
- QUIT
- +16 ;Save to workfile
- +17 DO SAVE(CDATE,EOBIEN,IEN101,EOBCNT,CNT)
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
- INACTIVE(CDATE) ;Search for any bill that is not ACTIVE
- +1 NEW CBILL,FBILL,FOUND,REC101,SUB,SUB101
- +2 SET SUB=0
- SET FOUND=0
- +3 FOR
- SET SUB=$ORDER(^IBM(361.1,"AEOB",CDATE,SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +4 SET SUB101=0
- +5 FOR
- SET SUB101=$ORDER(^IBM(361.1,"AEOB",CDATE,SUB,SUB101))
- if 'SUB101
- QUIT
- Begin DoDot:2
- +6 SET REC101=$GET(^IBM(361.1,SUB,101,SUB101,0))
- +7 ;From bill
- +8 SET FBILL=$PIECE(REC101,U,4)
- +9 IF FBILL
- SET FOUND=$$CHECK(FBILL)
- if FOUND
- QUIT
- +10 ;Current bill on EOB
- +11 SET CBILL=$PIECE($GET(^IBM(361.1,SUB,0)),U)
- +12 ;AR claim status
- +13 IF CBILL
- SET FOUND=$$CHECK(CBILL)
- End DoDot:2
- if FOUND
- QUIT
- End DoDot:1
- if FOUND
- QUIT
- +14 QUIT FOUND
- +15 ;
- CHECK(IEN430) ;Check claim status in AR
- +1 IF $$GET1^DIQ(430,IEN430,8)="ACTIVE"
- QUIT 0
- +2 QUIT 1
- +3 ;
- SAVE(CDATE,EOBIEN,IEN101,EOBCNT,CNT) ;Put the data into the ^TMP global
- +1 ; INPUTS: EOBIEN = ien of the EOB
- +2 ; IEN101 = ien of individual copy
- +3 ; EOBCNT = count of EOB found
- +4 ; CNT = count of claims within transaction
- +5 ; RETURNS : Builds each entry in the ^TMP global
- +6 ;
- +7 NEW BIEN,BEXT,DATE,DOS,PATIEN,PATNAM,PIEN,PEXT,PSQ,PSQEXT,REC0,STAT
- +8 NEW REC101,ORIG,MODE
- +9 ;Get EOB detail
- +10 SET REC0=$GET(^IBM(361.1,EOBIEN,0))
- +11 ;Bill pointer
- +12 SET BIEN=$PIECE(REC0,U)
- if 'BIEN
- QUIT
- +13 ;Get audit detail
- +14 SET REC101=$GET(^IBM(361.1,EOBIEN,101,IEN101,0))
- +15 ;Mode and Original claim
- +16 SET ORIG=$PIECE(REC101,U,4)
- SET MODE=$PIECE(REC101,U,5)
- +17 ;
- +18 ;If transaction is a move the only EOB is on the new claim
- +19 ;
- +20 ;Create report line for original claim
- +21 IF MODE="M"
- IF ORIG
- Begin DoDot:1
- +22 NEW BIEN
- +23 SET BIEN=ORIG
- DO SAVE1
- SET CNT=CNT+1
- End DoDot:1
- +24 ;
- +25 ;Save transaction for to bill
- +26 DO SAVE1
- +27 QUIT
- +28 ;
- SAVE1 ;Save unformatted bill details into ^TMP
- +1 ;
- +2 ;Get Bill number from bill IEN
- +3 SET BEXT=$PIECE($GET(^PRCA(430,BIEN,0)),U)
- +4 ;Patient IEN
- +5 SET PATIEN=$PIECE($GET(^DGCR(399,BIEN,0)),U,2)
- +6 ;Patient Name
- +7 SET PATNAM=$$EXTERNAL^DILFD(399,.02,,PATIEN)
- +8 ;DOS
- +9 SET DOS=$$FMTE^XLFDT($PIECE($GET(^DGCR(399,BIEN,0)),U,3),"2D")
- +10 ;Payer
- +11 SET PIEN=$PIECE(REC0,U,2)
- +12 ;Payer external form
- +13 SET PEXT=$$EXTERNAL^DILFD(361.1,.02,,PIEN)
- +14 ;If no payer name on EOB check AR claim
- +15 IF PEXT=""
- SET PEXT=$$GET1^DIQ(430,BIEN,9)
- +16 ;Truncate payer name to 18 characters
- +17 SET PEXT=$EXTRACT(PEXT,1,18)
- +18 ;Payer Sequence
- +19 SET PSQ=$PIECE(REC0,U,15)
- +20 ;Payer sequence - external
- +21 SET PSQEXT=$$EXTERNAL^DILFD(361.1,.15,,PSQ)
- +22 ;Display sequence if not null
- +23 if PSQEXT]""
- SET PEXT=PEXT_"/"_PSQEXT
- +24 ;AR claim status
- +25 SET STAT=$$GET1^DIQ(430,BIEN,8)
- +26 ;Date/Time EOB was moved/copied
- +27 SET DATE=$$FMTE^XLFDT(CDATE,"2S")
- +28 ;
- +29 SET ^TMP(RCPROG,$JOB,EOBCNT,CNT)=DATE_U_BEXT_U_PATNAM_U_DOS_U_PEXT_U_STAT
- +30 QUIT
- +31 ;
- BULLETIN ;Create bulletins only if moved/copied EOB found
- +1 ;
- +2 NEW ARRAY,BLANK,SBJ,SUB,SUBHDR,SUBHDR1,SUBHDR2,CNT,CNT1,RCPROG1,GLB
- +3 NEW LINE,DET
- +4 SET RCPROG1="RCDPEM8A"
- SET GLB=$NAME(^TMP(RCPROG1,$JOB,"XMTEXT"))
- +5 ;
- +6 ;Compile Move/Copy Transactions Bulletin
- +7 ;Build header
- +8 KILL @GLB
- +9 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-Move/Copy Transactions"
- +10 SET @GLB@(1)="The listed Move/Copy transaction(s) were performed within the last 24 hours"
- +11 SET @GLB@(2)="and at least one of the claims in each of the transactions was NOT ACTIVE."
- +12 SET @GLB@(3)=" "
- +13 SET @GLB@(4)="Total # of transactions - "_EOBCNT
- +14 SET @GLB@(6)=" "
- +15 SET @GLB@(7)="BILL # PATIENT DOS PAYER/SEQUENCE"
- +16 SET @GLB@(8)=" STATUS"
- +17 SET @GLB@(9)="----------------------------------------------------------------------------"
- +18 ;
- +19 ;Sub headers
- +20 SET SUBHDR="Transaction "
- +21 SET SUBHDR1=" - 'MOVE/COPY FROM' bill "
- +22 SET SUBHDR2=" 'MOVE/COPY TO' bill(s)"
- +23 SET BLANK=$JUSTIFY("",75)
- +24 ;
- +25 ;Move EOB search findings into message
- +26 SET EOBCNT=""
- SET CNT1=9
- +27 FOR
- SET EOBCNT=$ORDER(^TMP(RCPROG,$JOB,EOBCNT))
- if 'EOBCNT
- QUIT
- Begin DoDot:1
- +28 SET CNT=0
- +29 FOR
- SET CNT=$ORDER(^TMP(RCPROG,$JOB,EOBCNT,CNT))
- if 'CNT
- QUIT
- Begin DoDot:2
- +30 ;EOB data from scan
- +31 SET DET=$GET(^TMP(RCPROG,$JOB,EOBCNT,CNT))
- +32 ;Check if 'From' or 'To'
- +33 IF CNT=1
- SET LINE=SUBHDR_EOBCNT_SUBHDR1_$PIECE(DET,U)
- +34 IF '$TEST
- SET LINE=SUBHDR2
- +35 SET CNT1=CNT1+1
- SET @GLB@(CNT1)=LINE
- +36 SET CNT1=CNT1+1
- SET @GLB@(CNT1)=$$EOBL(DET)
- +37 SET CNT1=CNT1+1
- SET @GLB@(CNT1)=" "_$PIECE(DET,U,6)
- +38 SET CNT1=CNT1+1
- SET @GLB@(CNT1)=BLANK
- End DoDot:2
- End DoDot:1
- +39 SET @GLB@(CNT1+1)="** END OF REPORT **"
- +40 ;
- +41 ;Transmit mail message
- +42 NEW XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
- +43 SET XMDUZ=DUZ
- SET XMTEXT=GLB
- SET XMSUB=SBJ
- SET XMY("I:G.RCDPE MOVE COPY")=""
- +44 SET XMINSTR("FROM")="POSTMASTER"
- +45 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
- +46 KILL @GLB
- +47 QUIT
- +48 ;
- +49 ;
- EOBL(DET) ;Format EOB line
- +1 NEW BILL,DOS,PATIENT,PAYER,OUTPUT,SP
- +2 SET BILL=$PIECE(DET,U,2)
- SET PATIENT=$PIECE(DET,U,3)
- SET DOS=$PIECE(DET,U,4)
- SET SP=$JUSTIFY("",80)
- +3 SET PAYER=$PIECE(DET,U,5)
- +4 ;Truncate patient name
- +5 SET PATIENT=$EXTRACT(PATIENT,1,19)
- +6 ;Bill number
- +7 SET OUTPUT=BILL_$EXTRACT(SP,1,12-$LENGTH(BILL))
- +8 ;Patient
- +9 SET OUTPUT=OUTPUT_PATIENT_$EXTRACT(SP,1,20-$LENGTH(PATIENT))
- +10 ;DOS
- +11 SET OUTPUT=OUTPUT_DOS_$EXTRACT(SP,1,13-$LENGTH(DOS))
- +12 ;Payer
- +13 SET OUTPUT=OUTPUT_PAYER
- +14 ;
- +15 QUIT OUTPUT