| 1 | IBCNSUR3 ;WOIFO/AAT - MOVE SUBSCRIBERS (BULLETIN) ;09-SEP-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;add line to the bulletin
|
|---|
| 7 | ADD(IBTAB,IBX1,IBX2,IBX3,IBX4,IBX5) ;
|
|---|
| 8 | N IBX
|
|---|
| 9 | S IBLN=IBLN+1
|
|---|
| 10 | S IBX="" S:$G(IBTAB)>1 $E(IBX,IBTAB-1)=" "
|
|---|
| 11 | S @REF@(IBLN)=IBX_$G(IBX1)_$G(IBX2)_$G(IBX3)_$G(IBX4)_$G(IBX5)
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | BHEAD ; Bulletin header
|
|---|
| 15 | D ADD(1,"MOVE SUBSCRIBERS OF ONE PLAN TO ANOTHER PLAN")
|
|---|
| 16 | D ADD()
|
|---|
| 17 | D ADD(1,"You selected to move ",IBSUB," subscribers")
|
|---|
| 18 | D ADD()
|
|---|
| 19 | D ADD(5,"FROM Insurance Company ",IBC1N)
|
|---|
| 20 | D ADD(10,"Plan Name ",IBP1N," Number ",IBP1X)
|
|---|
| 21 | D ADD(5,"TO Insurance Company ",IBC2N)
|
|---|
| 22 | D ADD(10,"Plan Name ",IBP2N," Number ",IBP2X)
|
|---|
| 23 | I IBSPLIT D
|
|---|
| 24 | . D ADD(5,"BY switching to the new Insurance/Plan")
|
|---|
| 25 | . D ADD(10,"with Effective Date ",$$DAT1^IBOUTL(IBEFFDT))
|
|---|
| 26 | D ADD()
|
|---|
| 27 | D ADD(1,"The old insurance group plan is ",$S(IBSPLIT:"set EXPIRED",1:"REPLACED")," in the patient profile."),ADD()
|
|---|
| 28 | D ADD(1,"Patient Name/ID Whose Employer Effective Expires")
|
|---|
| 29 | D ADD(1,"-------------------------------------------------------------------------------")
|
|---|
| 30 | Q
|
|---|
| 31 | ; Add subscriber to the bulletin
|
|---|
| 32 | ADS(DFN,IBCDFN) ;
|
|---|
| 33 | N IBX,IBZ,IB2
|
|---|
| 34 | S IBZ=$G(^DPT(DFN,.312,IBCDFN,0))
|
|---|
| 35 | S IB2=$G(^DPT(DFN,.312,IBCDFN,2))
|
|---|
| 36 | S IBX=$E($P($G(^DPT(DFN,0)),U),1,22),$E(IBX,22)=" "
|
|---|
| 37 | S IBX=$E(IBX_$E($P($G(^DPT(DFN,0)),U,9),6,10),1,28),$E(IBX,28)=" "
|
|---|
| 38 | S IBX=$E(IBX_$$EXTERNAL^DILFD(2.312,6,,$P(IBZ,U,6)),1,36),$E(IBX,37)=" "
|
|---|
| 39 | S IBX=$E(IBX_$P(IB2,U,9),1,59),$E(IBX,59)=" "
|
|---|
| 40 | S IBX=$E(IBX_$$DAT1^IBOUTL($P(IBZ,U,8)),1,71),$E(IBX,71)=" "
|
|---|
| 41 | S IBX=$E(IBX_$$DAT1^IBOUTL($P(IBZ,U,4)),1,80)
|
|---|
| 42 | D ADD(1,IBX)
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | DONE ;
|
|---|
| 46 | N IBGRP,XMDUZ,XMTEXT,XMSUB,XMY,%
|
|---|
| 47 | ;
|
|---|
| 48 | D NOW^%DTC
|
|---|
| 49 | D ADD()
|
|---|
| 50 | D ADD(1,"THE PROCESS COMPLETED SUCCESSFULLY ON "_$$DAT1^IBOUTL(%,1))
|
|---|
| 51 | ;
|
|---|
| 52 | S XMSUB="SUBSCRIPTION LIST FOR INACTIVATED PLAN"
|
|---|
| 53 | S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="^TMP("_$J_",""IBCNSUR1"","
|
|---|
| 54 | S XMY(DUZ)=""
|
|---|
| 55 | S XMY("G.IB NEW INSURANCE")=""
|
|---|
| 56 | D ^XMD
|
|---|
| 57 | Q
|
|---|
