- IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 22-OCT-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- % G EN^IBCNSM
- ;
- VP ; -- View Patient Policy Info
- 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 ;W !,"Entry ",X,"Selected" D
- .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
- .Q:IBPPOL=""
- .D EN^VALM("IBCNS EXPANDED POLICY")
- .Q
- I '$G(IBFASTXT) D BLD^IBCNSM
- S VALMBCK="R" Q
- ;
- AB ; -- Edit Annual Benefits
- 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 FULL^VALM1
- .D EN^VALM("IBCNS ANNUAL BENEFITS")
- .Q
- S VALMBCK="R" Q
- ;
- UP ; -- Print new, not verified insurance
- ;
- N I,J,IBXX,IBCNS,VALMY
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) W !,IBXX,! H 2 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)
- .S INSCO=^DIC(36,IBCNS,0)
- .W !!,$P(INSCO,"^"),!! H 2
- .W !!,$P(IBPPOL,"^",4),!! H 2
- .Q
- D FULL^VALM1
- W !!,"REPORT OF NEW NOT VERIFIED INSURANCE",!! H 2
- S VALMBCK="R" Q
- ;
- PC ; -- Print Patient Insurance info
- ;N IBLINE,IBCY,IBWP
- N IBWP
- ;
- PCWP ; -- Print Insurance Coverage, Worksheet
- ;
- N I,J,IBXX,IBLINE,IBCY,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 IBCPOL=$P(IBPPOL,"^",22)
- .S IBLINE=$S($G(IBWP):1,1:0)
- .S IBCY=$S($G(IBWP):0,1:1)
- .D WPPC^IBCNSM5
- .Q
- S VALMBCK="R" Q
- ;
- WP ; -- Print Worksheet
- N IBWP
- S IBWP=1
- D PCWP
- S VALMBCK="R" Q
- ;
- DP ; -- Delete insurance policy
- D FULL^VALM1
- I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D SORRY^IBTRE1 G DPQ
- N I,J,IBXX,DIR,DIRUT,IBBCNT,BLD,IBCOVP,VALMY
- D EN^VALM2($G(XQORNOD(0)))
- S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11)
- I $D(VALMY) S IBXX=0 F S IBXX=$O(VALMY(IBXX)) Q:'IBXX!$D(DIRUT) D
- .S IBPPOL=$G(^TMP("IBNSMDX",$J,$O(^TMP("IBNSM",$J,"IDX",IBXX,0))))
- .; do some error checking here
- .I $$DELP^IBCNSU(DFN,$P(IBPPOL,"^",5)) D Q
- ..W !,"You can't delete this policy, there are bills associated with it."
- ..W ! S J=0 F S J=$O(^DGCR(399,"AE",DFN,$P(IBPPOL,"^",5),J)) Q:'J I $P(^DGCR(399,J,"S"),"^",17)="" W $P(^DGCR(399,J,0),"^")_" " S IBBCNT=$G(IBBCNT)+1 W:'(IBBCNT#8) !
- ..K IBBCNT
- ..Q
- .;
- .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are You Sure you want to delete policy #"_IBXX
- .D ^DIR K DIR I Y'=1 W !,"Policy #",IBXX," not Deleted!" Q
- .S IBCDFN=$P(IBPPOL,"^",4)
- .D DP1
- .Q
- DPQ D COVERED^IBCNSM31(DFN,$G(IBCOVP))
- D PAUSE^VALM1,BLD^IBCNSM:$G(BLD)
- S VALMBCK="R" Q
- ;
- DP1 ; -- actual deletion
- N DA,DIC,DIK
- ;
- ; -- if individual policy, and is right patient, delete HIP
- S BLD=1
- S IBCPOL=$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18),IBCPOLD=$G(^IBA(355.3,+IBCPOL,0))
- I '$P(IBCPOLD,"^",2),DFN=$P(IBCPOLD,"^",10) S DA=IBCPOL,DIK="^IBA(355.3," D ^DIK K DA,DIC,DIK
- ;
- ; -- delete entry in patient file
- S DA=IBCDFN,DA(1)=DFN,DIK="^DPT("_DFN_",.312," D ^DIK
- W:$G(IBXX) !,"Entry ",$G(IBXX)," Deleted"
- Q
- IBCNSM1 ;ALB/AAS - INSURANCE MANAGEMENT - OUTPUTS ; 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 ;
- % GOTO EN^IBCNSM
- +1 ;
- VP ; -- View Patient Policy Info
- +1 DO FULL^VALM1
- +2 NEW I,J,IBXX,VALMY
- +3 DO EN^VALM2($GET(XQORNOD(0)))
- +4 ;W !,"Entry ",X,"Selected" D
- 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 DO EN^VALM("IBCNS EXPANDED POLICY")
- +8 QUIT
- End DoDot:1
- +9 IF '$GET(IBFASTXT)
- DO BLD^IBCNSM
- +10 SET VALMBCK="R"
- QUIT
- +11 ;
- AB ; -- Edit Annual Benefits
- +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 FULL^VALM1
- +9 DO EN^VALM("IBCNS ANNUAL BENEFITS")
- +10 QUIT
- End DoDot:1
- +11 SET VALMBCK="R"
- QUIT
- +12 ;
- UP ; -- Print new, not verified insurance
- +1 ;
- +2 NEW I,J,IBXX,IBCNS,VALMY
- +3 DO EN^VALM2($GET(XQORNOD(0)))
- +4 IF $DATA(VALMY)
- SET IBXX=0
- FOR
- SET IBXX=$ORDER(VALMY(IBXX))
- WRITE !,IBXX,!
- HANG 2
- 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 SET INSCO=^DIC(36,IBCNS,0)
- +9 WRITE !!,$PIECE(INSCO,"^"),!!
- HANG 2
- +10 WRITE !!,$PIECE(IBPPOL,"^",4),!!
- HANG 2
- +11 QUIT
- End DoDot:1
- +12 DO FULL^VALM1
- +13 WRITE !!,"REPORT OF NEW NOT VERIFIED INSURANCE",!!
- HANG 2
- +14 SET VALMBCK="R"
- QUIT
- +15 ;
- PC ; -- Print Patient Insurance info
- +1 ;N IBLINE,IBCY,IBWP
- +2 NEW IBWP
- +3 ;
- PCWP ; -- Print Insurance Coverage, Worksheet
- +1 ;
- +2 NEW I,J,IBXX,IBLINE,IBCY,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 IBCPOL=$PIECE(IBPPOL,"^",22)
- +8 SET IBLINE=$SELECT($GET(IBWP):1,1:0)
- +9 SET IBCY=$SELECT($GET(IBWP):0,1:1)
- +10 DO WPPC^IBCNSM5
- +11 QUIT
- End DoDot:1
- +12 SET VALMBCK="R"
- QUIT
- +13 ;
- WP ; -- Print Worksheet
- +1 NEW IBWP
- +2 SET IBWP=1
- +3 DO PCWP
- +4 SET VALMBCK="R"
- QUIT
- +5 ;
- DP ; -- Delete insurance policy
- +1 DO FULL^VALM1
- +2 IF '$DATA(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))
- DO SORRY^IBTRE1
- GOTO DPQ
- +3 NEW I,J,IBXX,DIR,DIRUT,IBBCNT,BLD,IBCOVP,VALMY
- +4 DO EN^VALM2($GET(XQORNOD(0)))
- +5 SET IBCOVP=$PIECE($GET(^DPT(DFN,.31)),"^",11)
- +6 IF $DATA(VALMY)
- SET IBXX=0
- FOR
- SET IBXX=$ORDER(VALMY(IBXX))
- IF 'IBXX!$DATA(DIRUT)
- QUIT
- Begin DoDot:1
- +7 SET IBPPOL=$GET(^TMP("IBNSMDX",$JOB,$ORDER(^TMP("IBNSM",$JOB,"IDX",IBXX,0))))
- +8 ; do some error checking here
- +9 IF $$DELP^IBCNSU(DFN,$PIECE(IBPPOL,"^",5))
- Begin DoDot:2
- +10 WRITE !,"You can't delete this policy, there are bills associated with it."
- +11 WRITE !
- SET J=0
- FOR
- SET J=$ORDER(^DGCR(399,"AE",DFN,$PIECE(IBPPOL,"^",5),J))
- IF 'J
- QUIT
- IF $PIECE(^DGCR(399,J,"S"),"^",17)=""
- WRITE $PIECE(^DGCR(399,J,0),"^")_" "
- SET IBBCNT=$GET(IBBCNT)+1
- IF '(IBBCNT#8)
- WRITE !
- +12 KILL IBBCNT
- +13 QUIT
- End DoDot:2
- QUIT
- +14 ;
- +15 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Are You Sure you want to delete policy #"_IBXX
- +16 DO ^DIR
- KILL DIR
- IF Y'=1
- WRITE !,"Policy #",IBXX," not Deleted!"
- QUIT
- +17 SET IBCDFN=$PIECE(IBPPOL,"^",4)
- +18 DO DP1
- +19 QUIT
- End DoDot:1
- DPQ DO COVERED^IBCNSM31(DFN,$GET(IBCOVP))
- +1 DO PAUSE^VALM1
- IF $GET(BLD)
- DO BLD^IBCNSM
- +2 SET VALMBCK="R"
- QUIT
- +3 ;
- DP1 ; -- actual deletion
- +1 NEW DA,DIC,DIK
- +2 ;
- +3 ; -- if individual policy, and is right patient, delete HIP
- +4 SET BLD=1
- +5 SET IBCPOL=$PIECE($GET(^DPT(DFN,.312,IBCDFN,0)),"^",18)
- SET IBCPOLD=$GET(^IBA(355.3,+IBCPOL,0))
- +6 IF '$PIECE(IBCPOLD,"^",2)
- IF DFN=$PIECE(IBCPOLD,"^",10)
- SET DA=IBCPOL
- SET DIK="^IBA(355.3,"
- DO ^DIK
- KILL DA,DIC,DIK
- +7 ;
- +8 ; -- delete entry in patient file
- +9 SET DA=IBCDFN
- SET DA(1)=DFN
- SET DIK="^DPT("_DFN_",.312,"
- DO ^DIK
- +10 IF $GET(IBXX)
- WRITE !,"Entry ",$GET(IBXX)," Deleted"
- +11 QUIT
