IBCNSUR3 ;WOIFO/AAT - MOVE SUBSCRIBERS (BULLETIN) ;09-SEP-96
;;2.0;INTEGRATED BILLING;**276,549**;21-MAR-94;Build 54
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;add line to the bulletin
ADD(IBTAB,IBX1,IBX2,IBX3,IBX4,IBX5) ;
N IBX
S IBLN=IBLN+1
S IBX="" S:$G(IBTAB)>1 $E(IBX,IBTAB-1)=" "
S @REF@(IBLN)=IBX_$G(IBX1)_$G(IBX2)_$G(IBX3)_$G(IBX4)_$G(IBX5)
Q
;
BHEAD ; Bulletin header
D ADD(1,"MOVE SUBSCRIBERS OF ONE PLAN TO ANOTHER PLAN")
D ADD()
D ADD(1,"You selected to move ",$S(+$G(IBGRP):IBSUB,1:+NUMSEL)," subscriber(s)")
D ADD()
D ADD(5,"FROM Insurance Company ",IBC1N)
D ADD(10,"Plan Name ",$P(IBP1N,U,1)," Number ",IBP1X)
D ADD(5,"TO Insurance Company ",IBC2N)
D ADD(10,"Plan Name ",IBP2N," Number ",IBP2X)
I IBSPLIT D
. D ADD(5,"BY switching to the new Insurance/Plan")
. D ADD(10,"with Effective Date ",$$DAT1^IBOUTL(IBEFFDT))
D ADD()
D ADD(1,"The old group plan and policy was ",$S(IBSPLIT:"set EXPIRED",1:"REPLACED")," in the patient profile."),ADD()
D ADD(1,"Patient Name/ID Whose Employer Effective Expires")
D ADD(1,"-------------------------------------------------------------------------------")
Q
; Add subscriber to the bulletin
ADS(DFN,IBCDFN) ;
N IBX,IBZ,IB2
S IBZ=$G(^DPT(DFN,.312,IBCDFN,0))
S IB2=$G(^DPT(DFN,.312,IBCDFN,2))
S IBX=$E($P($G(^DPT(DFN,0)),U),1,22),$E(IBX,22)=" "
S IBX=$E(IBX_$E($P($G(^DPT(DFN,0)),U,9),6,10),1,28),$E(IBX,28)=" "
S IBX=$E(IBX_$$EXTERNAL^DILFD(2.312,6,,$P(IBZ,U,6)),1,36),$E(IBX,37)=" "
S IBX=$E(IBX_$P(IB2,U,9),1,59),$E(IBX,59)=" "
S IBX=$E(IBX_$$DAT1^IBOUTL($P(IBZ,U,8)),1,71),$E(IBX,71)=" "
S IBX=$E(IBX_$$DAT1^IBOUTL($P(IBZ,U,4)),1,80)
D ADD(1,IBX)
Q
;
DONE ;
N IBGRP,XMDUZ,XMTEXT,XMSUB,XMY,%
;
D NOW^%DTC
D ADD()
D ADD(1,"THE PROCESS COMPLETED SUCCESSFULLY ON "_$$DAT1^IBOUTL(%,1))
;
S XMSUB="SUBSCRIPTION LIST FOR INACTIVATED PLAN"
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="^TMP("_$J_",""IBCNSUR1"","
S XMY(DUZ)=""
S XMY("G.IB NEW INSURANCE")=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSUR3 2084 printed Sep 23, 2025@19:54:21 Page 2
IBCNSUR3 ;WOIFO/AAT - MOVE SUBSCRIBERS (BULLETIN) ;09-SEP-96
+1 ;;2.0;INTEGRATED BILLING;**276,549**;21-MAR-94;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;add line to the bulletin
ADD(IBTAB,IBX1,IBX2,IBX3,IBX4,IBX5) ;
+1 NEW IBX
+2 SET IBLN=IBLN+1
+3 SET IBX=""
if $GET(IBTAB)>1
SET $EXTRACT(IBX,IBTAB-1)=" "
+4 SET @REF@(IBLN)=IBX_$GET(IBX1)_$GET(IBX2)_$GET(IBX3)_$GET(IBX4)_$GET(IBX5)
+5 QUIT
+6 ;
BHEAD ; Bulletin header
+1 DO ADD(1,"MOVE SUBSCRIBERS OF ONE PLAN TO ANOTHER PLAN")
+2 DO ADD()
+3 DO ADD(1,"You selected to move ",$SELECT(+$GET(IBGRP):IBSUB,1:+NUMSEL)," subscriber(s)")
+4 DO ADD()
+5 DO ADD(5,"FROM Insurance Company ",IBC1N)
+6 DO ADD(10,"Plan Name ",$PIECE(IBP1N,U,1)," Number ",IBP1X)
+7 DO ADD(5,"TO Insurance Company ",IBC2N)
+8 DO ADD(10,"Plan Name ",IBP2N," Number ",IBP2X)
+9 IF IBSPLIT
Begin DoDot:1
+10 DO ADD(5,"BY switching to the new Insurance/Plan")
+11 DO ADD(10,"with Effective Date ",$$DAT1^IBOUTL(IBEFFDT))
End DoDot:1
+12 DO ADD()
+13 DO ADD(1,"The old group plan and policy was ",$SELECT(IBSPLIT:"set EXPIRED",1:"REPLACED")," in the patient profile.")
DO ADD()
+14 DO ADD(1,"Patient Name/ID Whose Employer Effective Expires")
+15 DO ADD(1,"-------------------------------------------------------------------------------")
+16 QUIT
+17 ; Add subscriber to the bulletin
ADS(DFN,IBCDFN) ;
+1 NEW IBX,IBZ,IB2
+2 SET IBZ=$GET(^DPT(DFN,.312,IBCDFN,0))
+3 SET IB2=$GET(^DPT(DFN,.312,IBCDFN,2))
+4 SET IBX=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U),1,22)
SET $EXTRACT(IBX,22)=" "
+5 SET IBX=$EXTRACT(IBX_$EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),6,10),1,28)
SET $EXTRACT(IBX,28)=" "
+6 SET IBX=$EXTRACT(IBX_$$EXTERNAL^DILFD(2.312,6,,$PIECE(IBZ,U,6)),1,36)
SET $EXTRACT(IBX,37)=" "
+7 SET IBX=$EXTRACT(IBX_$PIECE(IB2,U,9),1,59)
SET $EXTRACT(IBX,59)=" "
+8 SET IBX=$EXTRACT(IBX_$$DAT1^IBOUTL($PIECE(IBZ,U,8)),1,71)
SET $EXTRACT(IBX,71)=" "
+9 SET IBX=$EXTRACT(IBX_$$DAT1^IBOUTL($PIECE(IBZ,U,4)),1,80)
+10 DO ADD(1,IBX)
+11 QUIT
+12 ;
DONE ;
+1 NEW IBGRP,XMDUZ,XMTEXT,XMSUB,XMY,%
+2 ;
+3 DO NOW^%DTC
+4 DO ADD()
+5 DO ADD(1,"THE PROCESS COMPLETED SUCCESSFULLY ON "_$$DAT1^IBOUTL(%,1))
+6 ;
+7 SET XMSUB="SUBSCRIPTION LIST FOR INACTIVATED PLAN"
+8 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="^TMP("_$JOB_",""IBCNSUR1"","
+9 SET XMY(DUZ)=""
+10 SET XMY("G.IB NEW INSURANCE")=""
+11 DO ^XMD
+12 QUIT
