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

RCDPEM8.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; Main entry point for Moved/Copied EOB bulletins
  1. ;
  1. ; Integration Agreement IA 451 allows read of file #361.1 from AR
  1. ;
  1. N EOBCNT,RCPROG
  1. ;Clear workfiles
  1. S RCPROG="RCDPEM8" K ^TMP(RCPROG,$J)
  1. ;Set count of EOB found
  1. S EOBCNT=0
  1. ;
  1. ;Scan for today's moved/copied EOB's
  1. D EOBSCAN
  1. ;-----
  1. ; PRCA*4.5*298 - MailMan message disabled, logic retained - 14 Feb 2014
  1. ;Bulletin
  1. ;I EOBCNT D BULLETIN
  1. ;-----
  1. ;Clear workfiles
  1. K ^TMP(RCPROG,$J)
  1. Q
  1. ;
  1. EOBSCAN ;Scan EOB
  1. N CDATE,CNT,DONE,EOBIEN,IEN101,NOW
  1. ;Start day for scan is yesterday
  1. S NOW=$$NOW^XLFDT,CDATE=$$FMADD^XLFDT($P(NOW,"."),-1)
  1. ;Scan AEOB index for changed EOBs
  1. F S CDATE=$O(^IBM(361.1,"AEOB",CDATE)) Q:'CDATE D
  1. .;Check if change was over 24 hours ago
  1. .I $$FMDIFF^XLFDT(NOW,CDATE,2)>86400 Q
  1. .;Skip this transaction if all referenced claims are active
  1. .Q:'$$INACTIVE(CDATE)
  1. .;Otherwise save bulletin details for EOB's in the transaction
  1. .S EOBIEN="",CNT=0,EOBCNT=EOBCNT+1
  1. .F S EOBIEN=$O(^IBM(361.1,"AEOB",CDATE,EOBIEN)) Q:'EOBIEN D
  1. ..;Update counter
  1. ..S CNT=CNT+1
  1. ..S IEN101=$O(^IBM(361.1,"AEOB",CDATE,EOBIEN,"")) Q:'IEN101
  1. ..;Save to workfile
  1. ..D SAVE(CDATE,EOBIEN,IEN101,EOBCNT,CNT)
  1. Q
  1. ;
  1. INACTIVE(CDATE) ;Search for any bill that is not ACTIVE
  1. N CBILL,FBILL,FOUND,REC101,SUB,SUB101
  1. S SUB=0,FOUND=0
  1. F S SUB=$O(^IBM(361.1,"AEOB",CDATE,SUB)) Q:'SUB D Q:FOUND
  1. .S SUB101=0
  1. .F S SUB101=$O(^IBM(361.1,"AEOB",CDATE,SUB,SUB101)) Q:'SUB101 D Q:FOUND
  1. ..S REC101=$G(^IBM(361.1,SUB,101,SUB101,0))
  1. ..;From bill
  1. ..S FBILL=$P(REC101,U,4)
  1. ..I FBILL S FOUND=$$CHECK(FBILL) Q:FOUND
  1. ..;Current bill on EOB
  1. ..S CBILL=$P($G(^IBM(361.1,SUB,0)),U)
  1. ..;AR claim status
  1. ..I CBILL S FOUND=$$CHECK(CBILL)
  1. Q FOUND
  1. ;
  1. CHECK(IEN430) ;Check claim status in AR
  1. I $$GET1^DIQ(430,IEN430,8)="ACTIVE" Q 0
  1. Q 1
  1. ;
  1. SAVE(CDATE,EOBIEN,IEN101,EOBCNT,CNT) ;Put the data into the ^TMP global
  1. ; INPUTS: EOBIEN = ien of the EOB
  1. ; IEN101 = ien of individual copy
  1. ; EOBCNT = count of EOB found
  1. ; CNT = count of claims within transaction
  1. ; RETURNS : Builds each entry in the ^TMP global
  1. ;
  1. N BIEN,BEXT,DATE,DOS,PATIEN,PATNAM,PIEN,PEXT,PSQ,PSQEXT,REC0,STAT
  1. N REC101,ORIG,MODE
  1. ;Get EOB detail
  1. S REC0=$G(^IBM(361.1,EOBIEN,0))
  1. ;Bill pointer
  1. S BIEN=$P(REC0,U) Q:'BIEN
  1. ;Get audit detail
  1. S REC101=$G(^IBM(361.1,EOBIEN,101,IEN101,0))
  1. ;Mode and Original claim
  1. S ORIG=$P(REC101,U,4),MODE=$P(REC101,U,5)
  1. ;
  1. ;If transaction is a move the only EOB is on the new claim
  1. ;
  1. ;Create report line for original claim
  1. I MODE="M",ORIG D
  1. .N BIEN
  1. .S BIEN=ORIG D SAVE1 S CNT=CNT+1
  1. ;
  1. ;Save transaction for to bill
  1. D SAVE1
  1. Q
  1. ;
  1. SAVE1 ;Save unformatted bill details into ^TMP
  1. ;
  1. ;Get Bill number from bill IEN
  1. S BEXT=$P($G(^PRCA(430,BIEN,0)),U)
  1. ;Patient IEN
  1. S PATIEN=$P($G(^DGCR(399,BIEN,0)),U,2)
  1. ;Patient Name
  1. S PATNAM=$$EXTERNAL^DILFD(399,.02,,PATIEN)
  1. ;DOS
  1. S DOS=$$FMTE^XLFDT($P($G(^DGCR(399,BIEN,0)),U,3),"2D")
  1. ;Payer
  1. S PIEN=$P(REC0,U,2)
  1. ;Payer external form
  1. S PEXT=$$EXTERNAL^DILFD(361.1,.02,,PIEN)
  1. ;If no payer name on EOB check AR claim
  1. I PEXT="" S PEXT=$$GET1^DIQ(430,BIEN,9)
  1. ;Truncate payer name to 18 characters
  1. S PEXT=$E(PEXT,1,18)
  1. ;Payer Sequence
  1. S PSQ=$P(REC0,U,15)
  1. ;Payer sequence - external
  1. S PSQEXT=$$EXTERNAL^DILFD(361.1,.15,,PSQ)
  1. ;Display sequence if not null
  1. S:PSQEXT]"" PEXT=PEXT_"/"_PSQEXT
  1. ;AR claim status
  1. S STAT=$$GET1^DIQ(430,BIEN,8)
  1. ;Date/Time EOB was moved/copied
  1. S DATE=$$FMTE^XLFDT(CDATE,"2S")
  1. ;
  1. S ^TMP(RCPROG,$J,EOBCNT,CNT)=DATE_U_BEXT_U_PATNAM_U_DOS_U_PEXT_U_STAT
  1. Q
  1. ;
  1. BULLETIN ;Create bulletins only if moved/copied EOB found
  1. ;
  1. N ARRAY,BLANK,SBJ,SUB,SUBHDR,SUBHDR1,SUBHDR2,CNT,CNT1,RCPROG1,GLB
  1. N LINE,DET
  1. S RCPROG1="RCDPEM8A",GLB=$NA(^TMP(RCPROG1,$J,"XMTEXT"))
  1. ;
  1. ;Compile Move/Copy Transactions Bulletin
  1. ;Build header
  1. K @GLB
  1. S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-Move/Copy Transactions"
  1. S @GLB@(1)="The listed Move/Copy transaction(s) were performed within the last 24 hours"
  1. S @GLB@(2)="and at least one of the claims in each of the transactions was NOT ACTIVE."
  1. S @GLB@(3)=" "
  1. S @GLB@(4)="Total # of transactions - "_EOBCNT
  1. S @GLB@(6)=" "
  1. S @GLB@(7)="BILL # PATIENT DOS PAYER/SEQUENCE"
  1. S @GLB@(8)=" STATUS"
  1. S @GLB@(9)="----------------------------------------------------------------------------"
  1. ;
  1. ;Sub headers
  1. S SUBHDR="Transaction "
  1. S SUBHDR1=" - 'MOVE/COPY FROM' bill "
  1. S SUBHDR2=" 'MOVE/COPY TO' bill(s)"
  1. S BLANK=$J("",75)
  1. ;
  1. ;Move EOB search findings into message
  1. S EOBCNT="",CNT1=9
  1. F S EOBCNT=$O(^TMP(RCPROG,$J,EOBCNT)) Q:'EOBCNT D
  1. .S CNT=0
  1. .F S CNT=$O(^TMP(RCPROG,$J,EOBCNT,CNT)) Q:'CNT D
  1. ..;EOB data from scan
  1. ..S DET=$G(^TMP(RCPROG,$J,EOBCNT,CNT))
  1. ..;Check if 'From' or 'To'
  1. ..I CNT=1 S LINE=SUBHDR_EOBCNT_SUBHDR1_$P(DET,U)
  1. ..E S LINE=SUBHDR2
  1. ..S CNT1=CNT1+1,@GLB@(CNT1)=LINE
  1. ..S CNT1=CNT1+1,@GLB@(CNT1)=$$EOBL(DET)
  1. ..S CNT1=CNT1+1,@GLB@(CNT1)=" "_$P(DET,U,6)
  1. ..S CNT1=CNT1+1,@GLB@(CNT1)=BLANK
  1. S @GLB@(CNT1+1)="** END OF REPORT **"
  1. ;
  1. ;Transmit mail message
  1. N XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
  1. S XMDUZ=DUZ,XMTEXT=GLB,XMSUB=SBJ,XMY("I:G.RCDPE MOVE COPY")=""
  1. S XMINSTR("FROM")="POSTMASTER"
  1. D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
  1. K @GLB
  1. Q
  1. ;
  1. ;
  1. EOBL(DET) ;Format EOB line
  1. N BILL,DOS,PATIENT,PAYER,OUTPUT,SP
  1. S BILL=$P(DET,U,2),PATIENT=$P(DET,U,3),DOS=$P(DET,U,4),SP=$J("",80)
  1. S PAYER=$P(DET,U,5)
  1. ;Truncate patient name
  1. S PATIENT=$E(PATIENT,1,19)
  1. ;Bill number
  1. S OUTPUT=BILL_$E(SP,1,12-$L(BILL))
  1. ;Patient
  1. S OUTPUT=OUTPUT_PATIENT_$E(SP,1,20-$L(PATIENT))
  1. ;DOS
  1. S OUTPUT=OUTPUT_DOS_$E(SP,1,13-$L(DOS))
  1. ;Payer
  1. S OUTPUT=OUTPUT_PAYER
  1. ;
  1. Q OUTPUT