| [613] | 1 | IB20PT62 ;ALB/AAS - Insurance post init stuff ; 2/22/93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | W:'$D(ZTQUEUED) !!," I'll write a dot for each 100 entries"
|
|---|
| 5 | ;
|
|---|
| 6 | N IBTRNSF S IBTRNSF=0 I $O(^IBA(362.2,0)) S IBTRNSF=1 D DQ362
|
|---|
| 7 | ;
|
|---|
| 8 | DQ399 D NOW^%DTC S IBSCDT=%
|
|---|
| 9 | N IBCIFN
|
|---|
| 10 | W:'$D(ZTQUEUED) !!," Updating Bill/Claims file"
|
|---|
| 11 | S (IBCIFN,IBCNT,IBCNTD)=0
|
|---|
| 12 | F S IBCIFN=$O(^DGCR(399,IBCIFN)) Q:'IBCIFN D
|
|---|
| 13 | .I +$G(^DGCR(399,IBCIFN,"M")),$P($G(^(0)),"^",2) S ^DGCR(399,"AE",$P(^(0),"^",2),+^("M"),IBCIFN)=""
|
|---|
| 14 | .I +$P($G(^DGCR(399,IBCIFN,0)),U,13)=3 S ^DGCR(399,"AST",3,IBCIFN)=""
|
|---|
| 15 | .I '$G(IBTRNSF),$D(^DGCR(399,IBCIFN,"C")) D MVDX
|
|---|
| 16 | .I +$P($G(^DGCR(399,IBCIFN,0)),U,19)>1 D DXCPTCV
|
|---|
| 17 | .S IBCNT=$G(IBCNT)+1 I '$D(ZTQUEUED) W:'(IBCNT#100) "."
|
|---|
| 18 | S $P(^IBE(350.9,1,3),"^",19)=DT
|
|---|
| 19 | D NOW^%DTC S IBECDT=%
|
|---|
| 20 | I '$D(ZTQUEUED) W !," Completed!"
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | DQ362 ;transfer entries from 362.2 to 362.3
|
|---|
| 24 | N IBDIFN,IBD,IBCIFN,IBDX,IBP,IBDA,IBCNT
|
|---|
| 25 | I '$D(ZTQUEUED) W !!," Moving diagnosis to new file"
|
|---|
| 26 | S IBCNT=0,IBDIFN=0 F S IBDIFN=$O(^IBA(362.2,IBDIFN)) Q:'IBDIFN D
|
|---|
| 27 | .S IBD=$G(^IBA(362.2,IBDIFN,0))
|
|---|
| 28 | .S IBCIFN=+IBD,IBDX=+$P(IBD,U,2),IBP=$P(IBD,U,3)
|
|---|
| 29 | .I +IBCIFN,+IBDX D SETDX
|
|---|
| 30 | .S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#100) W "."
|
|---|
| 31 | S DIU="^IBA(362.2,",DIU(0)="D" D EN^DIU2 K DIU
|
|---|
| 32 | I '$D(ZTQUEUED) W " Completed!"
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | DXCPTCV ;transfer/convert associated dx (399,304,7->399,304,10)
|
|---|
| 36 | N IBCP,IBDX,IBDXP
|
|---|
| 37 | L +^DGCR(399,IBCIFN)
|
|---|
| 38 | S IBCP=0 F S IBCP=$O(^DGCR(399,IBCIFN,"CP",IBCP)) Q:'IBCP D
|
|---|
| 39 | . S IBDX=+$P($G(^DGCR(399,IBCIFN,"CP",IBCP,0)),U,8) Q:'IBDX
|
|---|
| 40 | . S IBDXP=$O(^IBA(362.3,"AIFN"_IBCIFN,IBDX,0)) Q:'IBDXP
|
|---|
| 41 | . S $P(^DGCR(399,IBCIFN,"CP",IBCP,0),U,11)=IBDXP
|
|---|
| 42 | L -^DGCR(399,IBCIFN)
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | MVDX ; -- move procedures from file 399 fields 64-68 to new file 362.2
|
|---|
| 46 | ;
|
|---|
| 47 | N IBC,IBDA,IBDX,IBP
|
|---|
| 48 | S IBC=$G(^DGCR(399,IBCIFN,"C"))
|
|---|
| 49 | F IBP=14:1:18 S IBDX=$P(IBC,"^",IBP) I IBDX D SETDX
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | SETDX Q:$D(^IBA(362.3,"AIFN"_IBCIFN,IBDX)) ; same diag for a bill not allowed
|
|---|
| 53 | L +^IBA(362.3,0):10 Q:'$T
|
|---|
| 54 | S IBDA=$P($G(^IBA(362.3,0)),"^",3)+1
|
|---|
| 55 | L -^IBA(362.3,0)
|
|---|
| 56 | F IBDA=IBDA:1 I '$D(^IBA(362.3,IBDA,0)) L +^IBA(362.3,IBDA) Q
|
|---|
| 57 | S ^IBA(362.3,IBDA,0)=IBDX_"^"_IBCIFN_"^"_IBP
|
|---|
| 58 | S ^IBA(362.3,"B",IBDX,IBDA)=""
|
|---|
| 59 | S ^IBA(362.3,"AIFN"_IBCIFN,IBDX,IBDA)=""
|
|---|
| 60 | I +IBP S ^IBA(362.3,"AO",IBCIFN,IBP,IBDA)=""
|
|---|
| 61 | L -^IBA(362.3,IBDA)
|
|---|
| 62 | L +^IBA(362.3,0):10
|
|---|
| 63 | S $P(^IBA(362.3,0),"^",4)=$P(^IBA(362.3,0),"^",3)+1
|
|---|
| 64 | S $P(^IBA(362.3,0),"^",3)=IBDA
|
|---|
| 65 | L -^IBA(362.3,0)
|
|---|
| 66 | S IBCNTD=$G(IBCNTD)+1
|
|---|
| 67 | Q
|
|---|
