IB20P297 ;OAK/ELZ - POST INSTALL ROUTINE FOR IB*2*297 ;03-JAN-2005
;;2.0;INTEGRATED BILLING;**297**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This is the post install routine for IB*2*297. This routine will
; run through the patient's insurance companies and identify insurance
; companies that do not have a plan associated with them.
; This routine can be deleted after the install, but you may want to
; keep it to review the insurance data again in the future.
;
POST ;
N IBMSG,ZTRTN,ZTDESC,ZTSK
S IBMSG(1)="I need to search for patient's with bad insurance data. You should queue"
S IBMSG(2)="this task to run a non-peek hours."
D MES^XPDUTL(.IBMSG)
;
S ZTRTN="DQ^IB20P297",ZTDESC="BAD INSURANCE DATA LIST",ZTIO=""
D ^%ZTLOAD
D MES^XPDUTL($S($G(ZTSK):"Task Queued #"_ZTSK,1:"Task not scheduled, you can run this by calling POST^IB20P297"))
;
Q
;
DQ ; tasked entry point
N DFN,IBINS,IBINSM,IBGRP,IBLINE,IBSAVE,XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZ,DIK,DA
K ^TMP("IB297",$J)
S IBLINE=8,IBSAVE=""
;
;
; first check out the AB xref to make sure everything is there
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN S IBINSM=0 F S IBINSM=$O(^DPT(DFN,.312,IBINSM)) Q:'IBINSM S IBINS=+$G(^DPT(DFN,.312,IBINSM,0)) D
. I $D(^DPT("AB",IBINS,DFN,IBINSM)) Q
. I IBINS,DFN,IBINSM S DIK="^DPT("_DFN_",.312,",DA(1)=DFN,DA=IBINSM,DIK(1)=.01 D EN^DIK
;
;
S IBINS=0 F S IBINS=$O(^DPT("AB",IBINS)) Q:'IBINS S DFN=0 F S DFN=$O(^DPT("AB",IBINS,DFN)) Q:'DFN S IBINSM=0 F S IBINSM=$O(^DPT("AB",IBINS,DFN,IBINSM)) Q:'IBINSM D
. ;
. ; first verify good x-ref or clean up
. S IBINS0=$G(^DPT(DFN,.312,IBINSM,0))
. I 'IBINS0 K ^DPT("AB",IBINS,DFN,IBINSM) Q
. ;
. ; do i have a plan?
. I '$P(IBINS0,"^",18) D SET(DFN,IBINS,IBINSM,"No Plan in Patient File") Q
. ;
. ; good pointer to 36?
. I '$D(^DIC(36,+IBINS0,0)) D SET(DFN,IBINS,IBINSM,"Ins Co not in File 36") Q
. ;
. ; good pointer in 355.3?
. I '$D(^IBA(355.3,+$P(IBINS0,"^",18),0)) D SET(DFN,IBINS,IBINSM,"Plan pointer not found") Q
. ;
. ; check out 355.3 to 36
. I $P(IBINS0,"^")'=$P($G(^IBA(355.3,+$P(IBINS0,"^",18),0)),"^") D SET(DFN,IBINS,IBINSM,"Plan to Ins Co Mis-match")
;
; data all looks good
I '$D(^TMP("IB297",$J)) S ^TMP("IB297",$J,IBLINE,0)="Data looks good, no problems to report"
;
; start message
S IBGRP=$P($G(^IBE(350.9,1,4)),"^",4),IBGRP=$S(IBGRP:$$EXTERNAL^DILFD(350.9,4.04,"",IBGRP),1:"IB NEW INSURANCE")
;
; build header
S ^TMP("IB297",$J,1,0)="The following insurance entries have been found with errors that need to"
S ^TMP("IB297",$J,2,0)="be resolved. You should use the ""Patient Insurance Info View/Edit [IBCN"
S ^TMP("IB297",$J,3,0)="PATIENT INSURANCE]"" option to edit the patient's insurance information"
S ^TMP("IB297",$J,4,0)="and correct as needed. If you just see a NULL value in a field that"
S ^TMP("IB297",$J,5,0)="indicates either the pointer value in a field is invalid or missing. You"
S ^TMP("IB297",$J,6,0)="may need to involve your IRM to resolve some of the issues on this report."
S ^TMP("IB297",$J,7,0)=""
;
; send away
S XMDUZ=$S(DUZ:DUZ,1:.5)
S XMSUBJ="INSURANCE FILE CLEAN UP NEEDED"
S XMBODY="^TMP(""IB297"",$J)"
S (XMTO("G.IB NEW INSURANCE"),XMTO($S(DUZ:DUZ,1:.5)))=""
S XMINSTR("FROM")="INTEGRATED BILLING PACKAGE"
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ)
;
;
K ^TMP("IB297",$J)
;
Q
;
SET(DFN,IBINS,IBINSM,IBERR) ;
N IBDFN0,IBINS0
;
; new ins co?
I IBSAVE'=IBINS S IBLINE=IBLINE+1,^TMP("IB297",$J,IBLINE,0)="",IBLINE=IBLINE+1,^TMP("IB297",$J,IBLINE,0)=" Insurance Co: "_$$EXTERNAL^DILFD(2.312,.01,"",IBINS),IBSAVE=IBINS
;
; get some data
S IBDFN0=$G(^DPT(DFN,0)),IBINS0=$G(^DPT(DFN,.312,+IBINSM,0))
;
; set the line
S IBLINE=IBLINE+1
S ^TMP("IB297",$J,IBLINE,0)=$$LJ^XLFSTR($P(IBDFN0,"^"),"20T")_" "_$$LJ^XLFSTR($P(IBDFN0,"^",9),"10T")_" "_$$LJ^XLFSTR($$EXTERNAL^DILFD(2.312,.18,"",$P(IBINS0,"^",18)),"15T")_" "_IBERR
;S ^TMP("IB297",$J,IBLINE,0)=$E($P(IBDFN0,"^"),1,20)_" "_$P(IBDFN0,"^",9)_" "_$E($$EXTERNAL^DILFD(2.312,.18,"",$P(IBINS0,"^",18)),1,15)_" "_IBERR
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P297 4208 printed Nov 22, 2024@17:12:14 Page 2
IB20P297 ;OAK/ELZ - POST INSTALL ROUTINE FOR IB*2*297 ;03-JAN-2005
+1 ;;2.0;INTEGRATED BILLING;**297**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This is the post install routine for IB*2*297. This routine will
+5 ; run through the patient's insurance companies and identify insurance
+6 ; companies that do not have a plan associated with them.
+7 ; This routine can be deleted after the install, but you may want to
+8 ; keep it to review the insurance data again in the future.
+9 ;
POST ;
+1 NEW IBMSG,ZTRTN,ZTDESC,ZTSK
+2 SET IBMSG(1)="I need to search for patient's with bad insurance data. You should queue"
+3 SET IBMSG(2)="this task to run a non-peek hours."
+4 DO MES^XPDUTL(.IBMSG)
+5 ;
+6 SET ZTRTN="DQ^IB20P297"
SET ZTDESC="BAD INSURANCE DATA LIST"
SET ZTIO=""
+7 DO ^%ZTLOAD
+8 DO MES^XPDUTL($SELECT($GET(ZTSK):"Task Queued #"_ZTSK,1:"Task not scheduled, you can run this by calling POST^IB20P297"))
+9 ;
+10 QUIT
+11 ;
DQ ; tasked entry point
+1 NEW DFN,IBINS,IBINSM,IBGRP,IBLINE,IBSAVE,XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZ,DIK,DA
+2 KILL ^TMP("IB297",$JOB)
+3 SET IBLINE=8
SET IBSAVE=""
+4 ;
+5 ;
+6 ; first check out the AB xref to make sure everything is there
+7 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET IBINSM=0
FOR
SET IBINSM=$ORDER(^DPT(DFN,.312,IBINSM))
if 'IBINSM
QUIT
SET IBINS=+$GET(^DPT(DFN,.312,IBINSM,0))
Begin DoDot:1
+8 IF $DATA(^DPT("AB",IBINS,DFN,IBINSM))
QUIT
+9 IF IBINS
IF DFN
IF IBINSM
SET DIK="^DPT("_DFN_",.312,"
SET DA(1)=DFN
SET DA=IBINSM
SET DIK(1)=.01
DO EN^DIK
End DoDot:1
+10 ;
+11 ;
+12 SET IBINS=0
FOR
SET IBINS=$ORDER(^DPT("AB",IBINS))
if 'IBINS
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^DPT("AB",IBINS,DFN))
if 'DFN
QUIT
SET IBINSM=0
FOR
SET IBINSM=$ORDER(^DPT("AB",IBINS,DFN,IBINSM))
if 'IBINSM
QUIT
Begin DoDot:1
+13 ;
+14 ; first verify good x-ref or clean up
+15 SET IBINS0=$GET(^DPT(DFN,.312,IBINSM,0))
+16 IF 'IBINS0
KILL ^DPT("AB",IBINS,DFN,IBINSM)
QUIT
+17 ;
+18 ; do i have a plan?
+19 IF '$PIECE(IBINS0,"^",18)
DO SET(DFN,IBINS,IBINSM,"No Plan in Patient File")
QUIT
+20 ;
+21 ; good pointer to 36?
+22 IF '$DATA(^DIC(36,+IBINS0,0))
DO SET(DFN,IBINS,IBINSM,"Ins Co not in File 36")
QUIT
+23 ;
+24 ; good pointer in 355.3?
+25 IF '$DATA(^IBA(355.3,+$PIECE(IBINS0,"^",18),0))
DO SET(DFN,IBINS,IBINSM,"Plan pointer not found")
QUIT
+26 ;
+27 ; check out 355.3 to 36
+28 IF $PIECE(IBINS0,"^")'=$PIECE($GET(^IBA(355.3,+$PIECE(IBINS0,"^",18),0)),"^")
DO SET(DFN,IBINS,IBINSM,"Plan to Ins Co Mis-match")
End DoDot:1
+29 ;
+30 ; data all looks good
+31 IF '$DATA(^TMP("IB297",$JOB))
SET ^TMP("IB297",$JOB,IBLINE,0)="Data looks good, no problems to report"
+32 ;
+33 ; start message
+34 SET IBGRP=$PIECE($GET(^IBE(350.9,1,4)),"^",4)
SET IBGRP=$SELECT(IBGRP:$$EXTERNAL^DILFD(350.9,4.04,"",IBGRP),1:"IB NEW INSURANCE")
+35 ;
+36 ; build header
+37 SET ^TMP("IB297",$JOB,1,0)="The following insurance entries have been found with errors that need to"
+38 SET ^TMP("IB297",$JOB,2,0)="be resolved. You should use the ""Patient Insurance Info View/Edit [IBCN"
+39 SET ^TMP("IB297",$JOB,3,0)="PATIENT INSURANCE]"" option to edit the patient's insurance information"
+40 SET ^TMP("IB297",$JOB,4,0)="and correct as needed. If you just see a NULL value in a field that"
+41 SET ^TMP("IB297",$JOB,5,0)="indicates either the pointer value in a field is invalid or missing. You"
+42 SET ^TMP("IB297",$JOB,6,0)="may need to involve your IRM to resolve some of the issues on this report."
+43 SET ^TMP("IB297",$JOB,7,0)=""
+44 ;
+45 ; send away
+46 SET XMDUZ=$SELECT(DUZ:DUZ,1:.5)
+47 SET XMSUBJ="INSURANCE FILE CLEAN UP NEEDED"
+48 SET XMBODY="^TMP(""IB297"",$J)"
+49 SET (XMTO("G.IB NEW INSURANCE"),XMTO($SELECT(DUZ:DUZ,1:.5)))=""
+50 SET XMINSTR("FROM")="INTEGRATED BILLING PACKAGE"
+51 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ)
+52 ;
+53 ;
+54 KILL ^TMP("IB297",$JOB)
+55 ;
+56 QUIT
+57 ;
SET(DFN,IBINS,IBINSM,IBERR) ;
+1 NEW IBDFN0,IBINS0
+2 ;
+3 ; new ins co?
+4 IF IBSAVE'=IBINS
SET IBLINE=IBLINE+1
SET ^TMP("IB297",$JOB,IBLINE,0)=""
SET IBLINE=IBLINE+1
SET ^TMP("IB297",$JOB,IBLINE,0)=" Insurance Co: "_$$EXTERNAL^DILFD(2.312,.01,"",IBINS)
SET IBSAVE=IBINS
+5 ;
+6 ; get some data
+7 SET IBDFN0=$GET(^DPT(DFN,0))
SET IBINS0=$GET(^DPT(DFN,.312,+IBINSM,0))
+8 ;
+9 ; set the line
+10 SET IBLINE=IBLINE+1
+11 SET ^TMP("IB297",$JOB,IBLINE,0)=$$LJ^XLFSTR($PIECE(IBDFN0,"^"),"20T")_" "_$$LJ^XLFSTR($PIECE(IBDFN0,"^",9),"10T")_" "_$$LJ^XLFSTR($$EXTERNAL^DILFD(2.312,.18,"",$PIECE(IBINS0,"^",18)),"15T")_" "_IBERR
+12 ;S ^TMP("IB297",$J,IBLINE,0)=$E($P(IBDFN0,"^"),1,20)_" "_$P(IBDFN0,"^",9)_" "_$E($$EXTERNAL^DILFD(2.312,.18,"",$P(IBINS0,"^",18)),1,15)_" "_IBERR
+13 ;
+14 QUIT
