| [613] | 1 | IBCNSOK ;ALB/AAS - Patient Insurance consistency checker ; 2/22/93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | % I '$D(DT) D DT^DICRW
|
|---|
| 6 | K ^TMP("IBCNS-ERR",$J)
|
|---|
| 7 | ;
|
|---|
| 8 | W !!,"Check Patient file Insurance Type Group Plan consistency"
|
|---|
| 9 | W !!,"I'm going to check the Insurance company for each patient policy with the",!,"Insurance company in the associated Group Plan file."
|
|---|
| 10 | W !!,"This will take a while, please queue this job to a device. I'll print",!,"a report when I'm done.",!!
|
|---|
| 11 | ;
|
|---|
| 12 | UP S IBUPDAT=0
|
|---|
| 13 | S DIR(0)="Y",DIR("A")="Update any Inconsistencies",DIR("B")="NO"
|
|---|
| 14 | S DIR("?")="Enter YES if you want any inconsistencies updated, enter NO if you just want the report."
|
|---|
| 15 | D ^DIR K DIR
|
|---|
| 16 | S IBUPDAT=+Y I $D(DIRUT) G END
|
|---|
| 17 | ;
|
|---|
| 18 | DEV W !! S %ZIS="QM" D ^%ZIS G:POP END
|
|---|
| 19 | I $D(IO("Q")) K IO("Q") D G END
|
|---|
| 20 | .S ZTRTN="DQ^IBCNSOK",ZTDESC="IB - v2 PATIENT FILE DOUBLE CHECK",ZTIO="",ZTSAVE("IB*")=""
|
|---|
| 21 | .W ! D ^%ZTLOAD D HOME^%ZIS
|
|---|
| 22 | .I $D(ZTSK) W !," Patient file update queued as task ",ZTSK K ZTSK Q
|
|---|
| 23 | ;
|
|---|
| 24 | D DQ G END
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | END K ^TMP("IBCNS-ERR",$J)
|
|---|
| 28 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 29 | D ^%ZISC
|
|---|
| 30 | K %ZIS,DIRUT,I,J,X,Y,DA,DR,DIC,DIE,DIR,IBCPOL,IBCOPOL2,IBCDFND,NODE,IBI,IBCNTI,IBCNTP,IBCNTPP,IBUPDT,IBCDFN
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | DQ ; -- entry point from task man
|
|---|
| 34 | U IO
|
|---|
| 35 | S IBQUIT=0
|
|---|
| 36 | D NOW^%DTC S IBSPDT=%
|
|---|
| 37 | I '$D(ZTQUEUED) D
|
|---|
| 38 | .W !!," I'll write a dot for each 100 entries"
|
|---|
| 39 | .W:IBUPDAT !," and a + for each entry updated"
|
|---|
| 40 | .W !," Start time: " S Y=IBSPDT D DT^DIQ
|
|---|
| 41 | N DFN,IBI,IBCPOL,IBCDFND,DA,DR,DIE,DIC,IBCNT,IBCNTP,IBCNTPP,IBCNTI,IBCDFN
|
|---|
| 42 | S (IBCNT,IBCNTP,IBCNTPP,IBCNTI,DFN)=0
|
|---|
| 43 | ;
|
|---|
| 44 | F S DFN=$O(^DPT(DFN)) Q:'DFN S IBCNT=IBCNT+1,IBCDFN=0 S:$O(^DPT(DFN,.312,IBCDFN)) IBCNTI=IBCNTI+1 F S IBCDFN=$O(^DPT(DFN,.312,IBCDFN)) Q:'IBCDFN D
|
|---|
| 45 | .I '$D(ZTQUEUED) W:'(IBCNTPP#100) "."
|
|---|
| 46 | .S IBCNTPP=IBCNTPP+1
|
|---|
| 47 | .S IBCDFND=$G(^DPT(DFN,.312,IBCDFN,0))
|
|---|
| 48 | .I IBCDFND="",$D(^DPT(DFN,.312,IBCDFN)) D ERR3
|
|---|
| 49 | .;
|
|---|
| 50 | .S IBCPOL=+$G(^IBA(355.3,+$P(IBCDFND,"^",18),0))
|
|---|
| 51 | .I '$P(IBCDFND,"^",18) D ERR1 Q ; no group plan field
|
|---|
| 52 | .I +IBCPOL'=+IBCDFND D ERR2 Q ; ins. companies don't match
|
|---|
| 53 | .Q
|
|---|
| 54 | ;
|
|---|
| 55 | D REPORT G END
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ERR1 ; -- no group plan pointer
|
|---|
| 59 | S NODE="IBCNS-ERR1" D FIX
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | ERR2 ; -- wrong insurance pointer
|
|---|
| 63 | S NODE="IBCNS-ERR2" D FIX
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | ERR3 ; -- dangle insurance node left
|
|---|
| 67 | S NODE="IBCNS-ERR3" D SET
|
|---|
| 68 | I IBUPDAT K ^DPT(DFN,.312,IBCDFN) W:'$D(ZTQUEUED) "+"
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | FIX ; -- reset pointer correctly
|
|---|
| 72 | S IBCPOL2=IBCPOL
|
|---|
| 73 | ;
|
|---|
| 74 | S IBCPOL=$$CHIP^IBCNSU(IBCDFND)
|
|---|
| 75 | Q:'IBCPOL
|
|---|
| 76 | Q:+IBCDFND'=+$G(^IBA(355.3,+IBCPOL,0)) ; patient ins. and policy must have same ins. company file.
|
|---|
| 77 | S DA=IBCDFN,DA(1)=DFN,DIE="^DPT("_DFN_",.312,"
|
|---|
| 78 | S DR="1.09////1;.18////"_IBCPOL
|
|---|
| 79 | D:IBUPDAT ^DIE K DA,DR,DIE,DIC W:'$D(ZTQUEUED) "+"
|
|---|
| 80 | SET S ^TMP("IBCNS-ERR",$J,$P(^DPT(DFN,0),"^"),DFN,IBCDFN)=IBCPOL2_"^"_IBCPOL_"^"_NODE
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | REPORT ; -- Okay now tell us about the errors
|
|---|
| 84 | D NOW^%DTC S IBHDT=$$FMTE^XLFDT(%),IBPAG=0
|
|---|
| 85 | D HDR
|
|---|
| 86 | S NAME="",NODE="IBCNS-ERR"
|
|---|
| 87 | I '$D(^TMP(NODE,$J)) W !!,"No Errors Found!" Q
|
|---|
| 88 | F S NAME=$O(^TMP(NODE,$J,NAME)) Q:NAME="" D
|
|---|
| 89 | .S DFN=0 F S DFN=$O(^TMP(NODE,$J,NAME,DFN)) Q:'DFN D
|
|---|
| 90 | ..S IBCDFN=0 F S IBCDFN=$O(^TMP(NODE,$J,NAME,DFN,IBCDFN)) Q:'IBCDFN S IBDATA=^(IBCDFN) D ONE
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | ONE ; -- print one line
|
|---|
| 94 | D PID^VADPT
|
|---|
| 95 | W !,$E($P($G(^DPT(DFN,0)),"^"),1,16)_" ("_DFN_")"
|
|---|
| 96 | W ?25,VA("PID")
|
|---|
| 97 | S IBCDFND=$G(^DPT(DFN,.312,IBCDFN,0))
|
|---|
| 98 | W ?39,$E($P($G(^DIC(36,+IBCDFND,0)),"^"),1,25)
|
|---|
| 99 | S IBCPOLD=$G(^IBA(355.3,+IBDATA,0))
|
|---|
| 100 | I +IBCPOLD W ?68,$E($P(IBCPOLD,"^",4)_"("_$P($G(^DIC(36,+IBCPOLD,0)),"^"),1,33)_")"
|
|---|
| 101 | S IBCPOLD=$G(^IBA(355.3,$P(IBDATA,"^",2),0))
|
|---|
| 102 | I +IBCPOLD W ?105,$E($P(IBCPOLD,"^",4)_"("_$P($G(^DIC(36,+IBCPOLD,0)),"^"),1,20)_")"
|
|---|
| 103 | W ?127,$S($G(IBUPDAT):"YES",1:"NO")
|
|---|
| 104 | W !?5,"Error: ",$S($P(IBDATA,"^",3)="IBCNS-ERR1":"Policy is missing group Plan",$P(IBDATA,"^",3)="IBCNS-ERR3":"Dangling insurance node detected",1:"Group Plan is with different insurance company")
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | HDR ; -- Print header
|
|---|
| 108 | Q:IBQUIT
|
|---|
| 109 | I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
|
|---|
| 110 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
|
|---|
| 111 | S IBPAG=IBPAG+1
|
|---|
| 112 | W !,"Patients with Incorrect Group Plans",?(IOM-33),"Page ",IBPAG," ",IBHDT
|
|---|
| 113 | W !,"PATIENT",?25,"PATIENT ID",?39,"INSURANCE CO.",?68,"OLD PLAN",?105,"NEW PLAN",?127,"UPDATED"
|
|---|
| 114 | W !,$TR($J(" ",IOM)," ","-")
|
|---|
| 115 | I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stoped at user request" Q
|
|---|
| 116 | Q
|
|---|
