IBCNSM2 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT ROUTINE ; 22-OCT-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% S U="^"
;
BU ; -- Enter Edit benefits already used
D FULL^VALM1
N I,J,IBXX,VALMY
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)
.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
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
D FULL^VALM1
S IBCH=$P(IBPPOL,U,1)
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,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($P($G(^DPT(DFN,.312,$P(IBPPOL,U,4),1)),U,3)) D PAUSE^VALM1
Q
IBCNSM2 ;ALB/AAS - INSURANCE MANAGEMENT - EDIT ROUTINE ; 22-OCT-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% SET U="^"
+1 ;
BU ; -- Enter Edit benefits already used
+1 DO FULL^VALM1
+2 NEW I,J,IBXX,VALMY
+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)
+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
+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
DO VFY
End DoDot:1
+7 ;
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
+3 DO FULL^VALM1
+4 SET IBCH=$PIECE(IBPPOL,U,1)
+5 SET IBDUZ=$PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,4)
+6 IF 'IBDUZ
DO REVASK
QUIT
+7 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))_". . ."
+8 IF $PIECE($PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,3),".")=DT
WRITE !,"COVERAGE VERIFIED TODAY, "_$$DAT1^IBOUTL(DT)
HANG 3
+9 IF '$TEST
DO REVASK
+10 QUIT
+11 ;
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,+IBDUZ,0)),U)_" ON "_$$DAT1^IBOUTL($PIECE($GET(^DPT(DFN,.312,$PIECE(IBPPOL,U,4),1)),U,3))
DO PAUSE^VALM1
+5 QUIT
