- 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
