source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20P336.m@ 1800

IB20P336 ;OAK/ELZ - IB*2*336 POST INIT TO REPORT CLAIMS TRACKING PROBLEMS ;15-DEC-2005

 ;;2.0;INTEGRATED BILLING;**336**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ; With the release of CIDC (IB*2*260), PSO added a new node for storage of SC/EI determinations.  However it turns

 ; out this new node is not always there.  If the node is there the data contained in that node is correct for SC/EI

 ; determination.  But if the node was not there IB needed to revert back to its original process for marking CT

 ; entries.  That reversion was not included in IB*2*260, but is included in this IB*2*336 patch.  This post init

 ; routine will look through CT entries for Pharmacy that were created after IB*2*260 was installed and evaluate

 ; those CT entries.  Since some sites spend time manually reviewing these entries the entries cannot be auto-

 ; matically marked and bills cannot be automatically cancelled.  So this post init routine will provide an e-mail

 ; report of CT entries that should be reviewed by the site.  Also as a note the PSO IBQ node is not a reliable

 ; node to look at for patients >49% SC, in fact should not ever be populated for these patients.  So if anyone

 ; does a comparison they are likely to find invalid data.  PSO stopped populating IBQ for >49% SC with the

 ; release of PSO*7*219.

 ; 

 ; 

POST ; post init entry point

 ;

 N IBIDT,IBX,IBSTOP,IBDATA,IBDPT,IBL,IBPNM,IBZ,XMDUZ,XMSUB,XMY,XMZ

 ;

 D BMES^XPDUTL("Starting Post Install to evaluate CT entries...")

 ;

 K ^TMP("IB20P336",$J)

 ;

 ; dbia #2197

 S IBIDT=$P($G(^XPD(9.7,+$O(^XPD(9.7,"B","IB*2.0*260",0)),1)),"^")

 I 'IBIDT D BMES^XPDUTL("Cannot find first install of IB*2*260!!!  LOG A REMEDY TICKET") Q

 ;

 ; start at end of CT file and work backwards to beginning

 S IBSTOP=0,IBX=":" F  S IBX=$O(^IBT(356,IBX),-1) Q:'IBX!(IBSTOP)  D

 . S IBZ=$G(^IBT(356,IBX,0))

 . Q:'$P(IBZ,"^",8)

 . ;

 . ; can i end?

 . S IBDT=+$G(^IBT(356,IBX,1)) I IBDT,IBDT<IBIDT S IBSTOP=1 Q

 . ;

 . ; entry has a RNB no need to check out

 . Q:$P(IBZ,"^",19)

 . ;

 . ; PSO has an ICD node so it was done right

 . Q:$D(^PSRX($P(IBZ,"^",8),"ICD"))

 . ;

 . ;determine RNB would have been had CIDC not been installed, if none quit

 . S IBRMARK=$$RNB($P(IBZ,"^",2),$P(IBZ,"^",6),$P(IBZ,"^",8),$G(^PSRX($P(IBZ,"^",8),0)))

 . I IBRMARK="" Q

 . ;

 . S IBDPT=$G(^DPT(+$P(IBZ,"^",2),0)) Q:'$L(IBDPT)

 . S IBDATA=$$TXT($P(IBDPT,"^"),15)_$$TXT($E($P(IBDPT,"^",9),6,9),4)

 . S IBDATA=IBDATA_$$TXT($$FMTE^XLFDT($P(IBZ,"^",6),"2DZ"),8)_$$TXT($P($G(^PSRX($P(IBZ,"^",8),0)),"^"),10)

 . S IBDATA=IBDATA_$$TXT($P($G(^DGCR(399,+$P(IBZ,"^",11),0)),"^"),10)_$$TXT(IBRMARK,14)

 . ;

 . ; get AR status

 . S:$P(IBZ,"^",11) IBDATA=IBDATA_$E($P($$STA^PRCAFN(+$P(IBZ,"^",11)),"^",2),1,4)

 . ; 

 . S ^TMP("IB20P336",$J,$P(IBDPT,"^"),IBX)=IBDATA

 ;

 D BMES^XPDUTL("Sending report message...")

 ;

 ; get message and send

RETRY ;

 S XMSUB="CLAIMS TRACKING PHARMACY IB*2*336"

 S XMDUZ="INTEGRATED BILLING PACKAGE"

 D XMZ^XMA2

 I XMZ<1 G RETRY

 ;

 ;set priority on message

 S DIE=3.9,DA=XMZ,DR="1.7////P" D ^DIE

 ;

 S ^XMB(3.9,XMZ,2,1,0)="With the install of the CIDC software (IB*2*260) some pharmacy related"

 S ^XMB(3.9,XMZ,2,2,0)="Claims Tracking (CT) entries may not have been assigned a Reason Not"

 S ^XMB(3.9,XMZ,2,3,0)="Billable (RNB).  Below is a list of CT entries that do not have a RNB"

 S ^XMB(3.9,XMZ,2,4,0)="with a RNB that should have been originally assigned to them.  Please"

 S ^XMB(3.9,XMZ,2,5,0)="review the list below and assign a RNB if appropriate."

 S ^XMB(3.9,XMZ,2,6,0)=" "

 S ^XMB(3.9,XMZ,2,7,0)="Name             SSN   Date      Rx#         Bill#       RNB             AR"

 S ^XMB(3.9,XMZ,2,8,0)="---------------  ----  --------  ----------  ----------  --------------  ----"

 S IBL=8

 S IBPNM="" F  S IBPNM=$O(^TMP("IB20P336",$J,IBPNM)) Q:IBPNM=""  S IBX=0 F  S IBX=$O(^TMP("IB20P336",$J,IBPNM,IBX)) Q:'IBX  D

 . S IBL=IBL+1

 . S ^XMB(3.9,XMZ,2,IBL,0)=^TMP("IB20P336",$J,IBPNM,IBX)

 I '$D(^TMP("IB20P336",$J)) S ^XMB(3.9,XMZ,2,IBL+1,0)="    <None Found>"

 S ^XMB(3.9,XMZ,2,0)="^3.92^"_IBL_"^"_IBL_"^"_DT

 ;

 S XMDUZ="INTEGRATED BILLING PACKAGE"

 S XMY(DUZ)="" ; Individual as a recipient

 F IBX="IB SUPERVISOR","IB CLAIMS SUPERVISOR" S IBZ=0 F  S IBZ=$O(^XUSEC(IBX,IBZ)) Q:'IBZ  S XMY(IBZ)=""

 ;

 D ENT1^XMD

 ;

 D BMES^XPDUTL("Message number "_XMZ_" sent...")

 ;

 K ^TMP("IB20P336",$J)

 ;

 D BMES^XPDUTL("Post Install Complete...")

 ;

 Q

 ;

 ;

RNB(DFN,IBDT,IBRXN,IBRXDATA) ; determines what the RNB would have been had the new ICD node not been checked

 ;

 N VAEL,IBRMARK,VA,IBPOWUNV,IBAUTRET

 ;

 D ELIG^VADPT

 ;if the patient is covered by insurance for pharmacy ($G(IBRMARK)="")

 ;AND if no copay in #350

 ;then we need to determine the non billable reason and set IBRMARK

 ;

 ;IF VAEL(3) -- if this is a veteran with SC(service connection) status

 I VAEL(3),'$G(^PSRX(IBRXN,"IB")) D

 . I $P(VAEL(3),"^",2)>49 S IBRMARK="NEEDS SC DETERMINATION"

 . ;in case of POW and Unempl. vet we cannot decide if the 3rd party should be exempt

 . S IBAUTRET=$$AUTOINFO^DGMTCOU1(DFN),IBPOWUNV=$S($P(IBAUTRET,U,8):1,$P(IBAUTRET,U,9):1,1:0)

 . I $P(VAEL(3),"^",2)<50 S IBRMARK=$S(IBPOWUNV:"NEEDS SC DETERMINATION",1:"SC TREATMENT")

 . I $$RXST^IBARXEU(DFN,$P(IBRXDATA,U,13))>0 S IBRMARK="NEEDS SC DETERMINATION"

 ;

 ;IF +VAEL(3)=0 if the veteran doesn't have SC status, but

 ;the veteran still may have CV status active

 I $G(IBRMARK)="",+VAEL(3)=0,'$G(^PSRX(IBRXN,"IB")) D

 . I $$CVEDT^IBACV(DFN,IBDT) S IBRMARK="NEEDS SC DETERMINATION" ;SC-because IB staff usually is using this reason to search for cases that need to be reviewed. COMBAT VETERAN reason will be used after review if this was the case

 ;

 ;

 Q $G(IBRMARK)

 ;

 ;

TXT(X,Y) ; make text Y characters long adding 2 spaces

 Q $$LJ^XLFSTR($E(X,1,Y),Y+2)

 ;