source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSUR3.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1IBCNSUR3 ;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
7ADD(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 ;
14BHEAD ; 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
32ADS(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 ;
45DONE ;
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
Note: See TracBrowser for help on using the repository browser.