IBCNSM2 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT ROUTINE ;22-OCT-92
;;2.0;INTEGRATED BILLING;**28,103,139,516,528,668**;21-MAR-94;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
;/vd-IB*2*668 - Removed the SSVI logic introduced with IB*2*528 in its entirety within VistA.
;
% S U="^"
;
BU ; -- Enter Edit benefits already used
D FULL^VALM1
N I,J,IBXX,VALMY,IBCNS,IBCPOL,IBCDFN
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.Q:IBPPOL=""
.S IBCNS=+$P(IBPPOL,"^",5),IBCPOL=+$P(IBPPOL,"^",22),IBCDFN=+$P(IBPPOL,"^",4)
.D EN^VALM("IBCNS BENEFITS USED BY DATE")
.Q
S VALMBCK="R" Q
;
EP ; -- Enter Edit Patient Insurance Policy Information
;
S VALMBCK="R" Q
;
EI ; -- Enter Edit Insurance Company Information
; -- if coming from benefit screen
; ibcns=insurance co number
D FULL^VALM1
I $G(IBCNS)>0 D EN^VALM("IBCNS INSURANCE COMPANY") G EIQ
;
; -- if coming from list of policies, allow selection
N I,J,IBXX,IBCNS,VALMY
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S I=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.S IBCNS=$P(I,"^",5)
.D EN^VALM("IBCNS INSURANCE COMPANY")
EIQ S VALMBCK="R" Q
;
VC ; -- Verify Insurance Coverage
D FULL^VALM1
N I,J,IBXX,VALMY,CON
;
; -- If no effective policies ask to verify no coverage
I '$$EPOL(DFN) D VCN G EXIT
;
D EN^VALM2($G(XQORNOD(0)))
I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX D
.S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
.Q:IBPPOL=""
.D VFY
;
EXIT ; -- Kill variables, refresh screen
;
D BLD^IBCNSM
K I,J,IBXX,DA,DR,IBDUZZ
S VALMBCK="R" Q
;
VFY ; -- Display most recent verification
;
N DA,DR,IBDUZ,IB0,IBWNR
D FULL^VALM1
S IBCH=$P(IBPPOL,U,1)
S IBWNR=$$GETWNR^IBCNSMM1()
;
; -- If Medicare WNR and Name of Insured is different from Pt. Name
; display Warning message.
;S IB0=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0)) ; 516 - baa
S IB0=$$ZND^IBCNS1(DFN,$P(IBPPOL,U,4)) ; 516 - baa
I +IBWNR=+IB0 D
.I $P(IB0,U,17)="" Q
.I $P(IB0,U,17)=$P($G(^DPT(DFN,0)),U,1) Q
.W !!,"WARNING: Patient Name: '"_$P($G(^DPT(DFN,0)),U,1)_"' DOES NOT MATCH"
.W !," Name of Insured: '"_$P(IB0,U,17)_"' for this "_$P(IBWNR,U,2)_" policy."
;
S IBDUZ=$P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,4)
I 'IBDUZ D REVASK Q
W !!," "_IBCH_" LAST VERIFIED BY "_$P($G(^VA(200,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3))_". . ."
I $P($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3),".")=DT W !,"COVERAGE VERIFIED TODAY, "_$$DAT1^IBOUTL(DT) H 3
E D REVASK
Q
;
REVASK ; -- Determine whether user wishes to re-verify
;
N Y
W:'IBDUZ !
S DIR("B")="No",DIR(0)="YO",DIR("A")=$S('IBDUZ:" "_IBCH_" NEVER PREVIOUSLY VERIFIED. DO YOU WISH TO VERIFY COVERAGE",1:"ARE YOU RE-VERIFYING COVERAGE TODAY")
D ^DIR K DIR Q:$D(DIRUT)
I Y D REVFY
Q
;
REVFY ; -- Re-verify
;
S DA(1)=DFN,DA=$P(IBPPOL,U,4),DIE="^DPT(DFN,.312,",DR="1.03////"_DT_";1.04////"_DUZ D ^DIE K DIE
S IBDUZ=$P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,4)
W !," "_IBCH_" VERIFIED BY "_$P($G(^VA(200,+DUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3))
D PAUSE^VALM1
Q
;
VCN ; -- Ask to verifiy patient has no coverage
;
N DA,DLAYGO,DIE,DIR,DR,DIRUT,DUOUT,DIOUT,DTOUT,IBADD,IBEXERR,IBWHER,X,Y
W !!,?5,"Patient has no effective insurance coverage on file."
S DIR("B")="No",DIR(0)="Y"
S DIR("A")=$S(+$G(^IBA(354,DFN,60)):"Re-v",1:"V")_"erify that patient has No Insurance Coverage "
S DIR("?")="Enter 'Yes' to enter a Verification of No Coverage Date"
D ^DIR
I Y D
.I '$D(^IBA(354,DFN)) D ADDP^IBAUTL6 I '$G(IBADD) W " <Try again Later>" Q
.S DA=DFN,DIE="^IBA(354,",DR=60 D ^DIE I $D(Y)=0 N IBX S IBX=$P($G(^DPT(DFN,.31)),"^",11) D
..I X]""&(IBX'="N") S IBX="N",$P(^DPT(DFN,.31),"^",11)="N" D MSG
..I X']""&(IBX'="U") S IBX="U",$P(^DPT(DFN,.31),"^",11)="U" D MSG
..Q
Q
;
EPOL(DFN) ; Does the patient have any effective policies?
; Input: DFN -- Pointer to the patient in file #2
; Output: 0 -- The patient has no effective policies
; 1 -- The patient has at least one effective policy
;
N J,X,Y S Y=0
S J=0 F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) D Q:Y
.I '$P(X,"^",4) S Y=1 Q
.I $P(X,"^",4)>DT S Y=1
Q Y
;
MSG ;If there is a change in the status of the covered by health insurance
;field #11 in the Patient file #2, The user is notified of the change.
I '$D(ZTQUEUED) S VALMSG="COVERED BY HEALTH INSURANCE changed to '"_IBX_$S(IBX="U":"NKNOWN'",1:"O'")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSM2 4769 printed Dec 13, 2024@02:17:26 Page 2
IBCNSM2 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT ROUTINE ;22-OCT-92
+1 ;;2.0;INTEGRATED BILLING;**28,103,139,516,528,668**;21-MAR-94;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;/vd-IB*2*668 - Removed the SSVI logic introduced with IB*2*528 in its entirety within VistA.
+5 ;
% SET U="^"
+1 ;
BU ; -- Enter Edit benefits already used
+1 DO FULL^VALM1
+2 NEW I,J,IBXX,VALMY,IBCNS,IBCPOL,IBCDFN
+3 DO EN^VALM2($GET(XQORNOD(0)))
+4 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+5 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+6 if IBPPOL=""
QUIT
+7 SET IBCNS=+$PIECE(IBPPOL,"^",5)
SET IBCPOL=+$PIECE(IBPPOL,"^",22)
SET IBCDFN=+$PIECE(IBPPOL,"^",4)
+8 DO EN^VALM("IBCNS BENEFITS USED BY DATE")
+9 QUIT
End DoDot:1
+10 SET VALMBCK="R"
QUIT
+11 ;
EP ; -- Enter Edit Patient Insurance Policy Information
+1 ;
+2 SET VALMBCK="R"
QUIT
+3 ;
EI ; -- Enter Edit Insurance Company Information
+1 ; -- if coming from benefit screen
+2 ; ibcns=insurance co number
+3 DO FULL^VALM1
+4 IF $GET(IBCNS)>0
DO EN^VALM("IBCNS INSURANCE COMPANY")
GOTO EIQ
+5 ;
+6 ; -- if coming from list of policies, allow selection
+7 NEW I,J,IBXX,IBCNS,VALMY
+8 DO EN^VALM2($GET(XQORNOD(0)))
+9 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+10 SET I=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+11 SET IBCNS=$PIECE(I,"^",5)
+12 DO EN^VALM("IBCNS INSURANCE COMPANY")
End DoDot:1
EIQ SET VALMBCK="R"
QUIT
+1 ;
VC ; -- Verify Insurance Coverage
+1 DO FULL^VALM1
+2 NEW I,J,IBXX,VALMY,CON
+3 ;
+4 ; -- If no effective policies ask to verify no coverage
+5 IF '$$EPOL(DFN)
DO VCN
GOTO EXIT
+6 ;
+7 DO EN^VALM2($GET(XQORNOD(0)))
+8 IF $DATA(VALMY)
SET IBXX=0
FOR
SET IBXX=$ORDER(VALMY(IBXX))
if 'IBXX
QUIT
Begin DoDot:1
+9 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
+10 if IBPPOL=""
QUIT
+11 DO VFY
End DoDot:1
+12 ;
EXIT ; -- Kill variables, refresh screen
+1 ;
+2 DO BLD^IBCNSM
+3 KILL I,J,IBXX,DA,DR,IBDUZZ
+4 SET VALMBCK="R"
QUIT
+5 ;
VFY ; -- Display most recent verification
+1 ;
+2 NEW DA,DR,IBDUZ,IB0,IBWNR
+3 DO FULL^VALM1
+4 SET IBCH=$PIECE(IBPPOL,U,1)
+5 SET IBWNR=$$GETWNR^IBCNSMM1()
+6 ;
+7 ; -- If Medicare WNR and Name of Insured is different from Pt. Name
+8 ; display Warning message.
+9 ;S IB0=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0)) ; 516 - baa
+10 ; 516 - baa
SET IB0=$$ZND^IBCNS1(DFN,$PIECE(IBPPOL,U,4))
+11 IF +IBWNR=+IB0
Begin DoDot:1
+12 IF $PIECE(IB0,U,17)=""
QUIT
+13 IF $PIECE(IB0,U,17)=$PIECE($GET(^DPT(DFN,0)),U,1)
QUIT
+14 WRITE !!,"WARNING: Patient Name: '"_$PIECE($GET(^DPT(DFN,0)),U,1)_"' DOES NOT MATCH"
+15 WRITE !," Name of Insured: '"_$PIECE(IB0,U,17)_"' for this "_$PIECE(IBWNR,U,2)_" policy."
End DoDot:1
+16 ;
+17 SET IBDUZ=$PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,4)
+18 IF 'IBDUZ
DO REVASK
QUIT
+19 WRITE !!," "_IBCH_" LAST VERIFIED BY "_$PIECE($GET(^VA(200,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,3))_". . ."
+20 IF $PIECE($PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,3),".")=DT
WRITE !,"COVERAGE VERIFIED TODAY, "_$$DAT1^IBOUTL(DT)
HANG 3
+21 IF '$TEST
DO REVASK
+22 QUIT
+23 ;
REVASK ; -- Determine whether user wishes to re-verify
+1 ;
+2 NEW Y
+3 if 'IBDUZ
WRITE !
+4 SET DIR("B")="No"
SET DIR(0)="YO"
SET DIR("A")=$SELECT('IBDUZ:" "_IBCH_" NEVER PREVIOUSLY VERIFIED. DO YOU WISH TO VERIFY COVERAGE",1:"ARE YOU RE-VERIFYING COVERAGE TODAY")
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+6 IF Y
DO REVFY
+7 QUIT
+8 ;
REVFY ; -- Re-verify
+1 ;
+2 SET DA(1)=DFN
SET DA=$PIECE(IBPPOL,U,4)
SET DIE="^DPT(DFN,.312,"
SET DR="1.03////"_DT_";1.04////"_DUZ
DO ^DIE
KILL DIE
+3 SET IBDUZ=$PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,4)
+4 WRITE !," "_IBCH_" VERIFIED BY "_$PIECE($GET(^VA(200,+DUZ,0)),U)_" ON "_$$DAT1^IBOUTL($PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,3))
+5 DO PAUSE^VALM1
+6 QUIT
+7 ;
VCN ; -- Ask to verifiy patient has no coverage
+1 ;
+2 NEW DA,DLAYGO,DIE,DIR,DR,DIRUT,DUOUT,DIOUT,DTOUT,IBADD,IBEXERR,IBWHER,X,Y
+3 WRITE !!,?5,"Patient has no effective insurance coverage on file."
+4 SET DIR("B")="No"
SET DIR(0)="Y"
+5 SET DIR("A")=$SELECT(+$GET(^IBA(354,DFN,60)):"Re-v",1:"V")_"erify that patient has No Insurance Coverage "
+6 SET DIR("?")="Enter 'Yes' to enter a Verification of No Coverage Date"
+7 DO ^DIR
+8 IF Y
Begin DoDot:1
+9 IF '$DATA(^IBA(354,DFN))
DO ADDP^IBAUTL6
IF '$GET(IBADD)
WRITE " <Try again Later>"
QUIT
+10 SET DA=DFN
SET DIE="^IBA(354,"
SET DR=60
DO ^DIE
IF $DATA(Y)=0
NEW IBX
SET IBX=$PIECE($GET(^DPT(DFN,.31)),"^",11)
Begin DoDot:2
+11 IF X]""&(IBX'="N")
SET IBX="N"
SET $PIECE(^DPT(DFN,.31),"^",11)="N"
DO MSG
+12 IF X']""&(IBX'="U")
SET IBX="U"
SET $PIECE(^DPT(DFN,.31),"^",11)="U"
DO MSG
+13 QUIT
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
EPOL(DFN) ; Does the patient have any effective policies?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; Output: 0 -- The patient has no effective policies
+3 ; 1 -- The patient has at least one effective policy
+4 ;
+5 NEW J,X,Y
SET Y=0
+6 SET J=0
FOR
SET J=$ORDER(^DPT(DFN,.312,J))
if 'J
QUIT
SET X=$GET(^(J,0))
Begin DoDot:1
+7 IF '$PIECE(X,"^",4)
SET Y=1
QUIT
+8 IF $PIECE(X,"^",4)>DT
SET Y=1
End DoDot:1
if Y
QUIT
+9 QUIT Y
+10 ;
MSG ;If there is a change in the status of the covered by health insurance
+1 ;field #11 in the Patient file #2, The user is notified of the change.
+2 IF '$DATA(ZTQUEUED)
SET VALMSG="COVERED BY HEALTH INSURANCE changed to '"_IBX_$SELECT(IBX="U":"NKNOWN'",1:"O'")
+3 QUIT
