Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSUR3

IBCNSUR3.m

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