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

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1IBCNSBL1 ;ALB/AAS - NEW INSURANCE POLICY BULLETIN ;29-AUG-93
2 ;;2.0;INTEGRATED BILLING;**6,28,82,249,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BULL ; -- send bulletin
6 N IBCNT
7 S XMSUB="New Insurance Policy For "_$E($P(IBP,"^"),1,20)_" Pt. Id: "_$P(IBP,"^",2)
8 S IBT(1)=" A new insurance policy has been added for:"
9 S IBT(2)=" Patient: "_$E($P(IBP,"^")_" ",1,25)_" PT. ID: "_$P(IBP,"^",2)
10 S IBT(3)=""
11 S IBT(4)=" New Policy: "
12 S IBCNT=4 D HDR,NPOL
13 S IBCNT=IBCNT+1,IBT(IBCNT)=""
14 S IBCNT=IBCNT+1,IBT(IBCNT)=" Previous Policy(s): "
15 D HDR,OPOL
16 S IBCNT=IBCNT+1,IBT(IBCNT)=""
17 S IBCNT=IBCNT+1,IBT(IBCNT)=" Buffer Policy(s): "
18 D BUFF
19 S IBCNT=IBCNT+1,IBT(IBCNT)=""
20 S IBCNT=IBCNT+1,IBT(IBCNT)=" Possible billable Inpt. Care: "
21 D INPT
22 S IBCNT=IBCNT+1,IBT(IBCNT)=""
23 S IBCNT=IBCNT+1,IBT(IBCNT)=" Possible billable Opt. Care: "
24 D OPT
25 I $$ECMEBIL^IBNCPDPU(DFN,DT) D
26 . S IBCNT=IBCNT+1,IBT(IBCNT)=""
27 . S IBCNT=IBCNT+1,IBT(IBCNT)=" *** NOTE: Prescriptions for this patient are ECME BILLABLE and may be"
28 . S IBCNT=IBCNT+1,IBT(IBCNT)=" processed using the GENERATE ECME RX BILLS option contained in the"
29 . S IBCNT=IBCNT+1,IBT(IBCNT)=" Billing Clerk's Menu"
30 ;
31 S IBCNT=IBCNT+1,IBT(IBCNT)=""
32 S IBCNT=IBCNT+1,IBT(IBCNT)=" Added by: "_$P($G(^VA(200,+$P(IBEVTA1,"^",2),0)),"^")
33 S IBCNT=IBCNT+1,IBT(IBCNT)=" on: "_$$DAT1^IBOUTL(+IBEVTA1,"2P")
34 S IBCNT=IBCNT+1,IBT(IBCNT)=" Option: "
35 ;
36 I $D(XQY0) S IBT(IBCNT)=IBT(IBCNT)_$P($G(XQY0),"^",2)
37 I $D(ZTQUEUED),$P($G(XQY0),"^",2)="" S IBT(IBCNT)=IBT(IBCNT)_"Queued Job - "_$G(ZTDESC)
38 D SEND
39BULLQ Q
40 ;
41NPOL ; -- set up new policy
42 S IBCNT=IBCNT+1
43 S IBT(IBCNT)=$$D1(IBEVTA0)
44 Q
45 ;
46OPOL ; -- set up old policies
47 N J,X,IBPCNT
48 S J=0 F S J=$O(^DPT(DFN,.312,J)) Q:'J I J'=IBCDFN S X=$G(^DPT(DFN,.312,J,0)) S IBCNT=IBCNT+1,IBT(IBCNT)=$$D1(X) S IBPCNT=$G(IBPCNT)+1
49 I $G(IBPCNT)<1 S IBCNT=IBCNT+1,IBT(IBCNT)=" No Previous Policies On file!"
50 Q
51 ;
52SEND S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
53 K XMY S XMN=0
54 S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,4)),"^",4),0)),"^")
55 I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
56 D ^XMD
57 K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB
58 Q
59 ;
60HDR ; -- print standard header
61 D HDR1("=",76)
62 Q
63 ;
64HDR1(CHAR,LENG) ; -- print header, specify character
65 S IBCNT=IBCNT+1
66 S IBT(IBCNT)=" Insurance Co. Subscriber ID Group Holder Effective Expires"
67 S IBCNT=IBCNT+1,X="",$P(X,CHAR,LENG)=""
68 S IBT(IBCNT)=X
69 Q
70 ;
71 ;
72D1(IBINS) N X,IBX
73 S IBX="" I '$G(IBINS) G DQ
74 S IBX=" "_$E($S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")_" ",1,16)_" "
75 S IBX=IBX_$E($P(IBINS,"^",2)_" ",1,16)_" "
76 S IBX=IBX_$E($$GRP^IBCNS($P(IBINS,"^",18))_" ",1,10)_" "
77 S X=$P(IBINS,"^",6) S IBX=IBX_$E($S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER")_" ",1,8)
78 S IBX=IBX_$E($$DAT1^IBOUTL($P(IBINS,"^",8))_" ",1,10)_$$DAT1^IBOUTL($P(IBINS,"^",4))
79DQ Q IBX
80 ;
81OPT ; -- list opt treatment (sched appoints only)
82 N CNT S CNT=0
83 ;
84 I $D(^TMP($J,"SDAMA201","GETAPPT","ERROR")) S IBCNT=IBCNT+1,IBT(IBCNT)=" Unable to look-up Scheduled Appointments." D Q
85 . F S CNT=$O(^TMP($J,"SDAMA201","GETAPPT","ERROR",CNT)) Q:'CNT S IBCNT=IBCNT+1,IBT(IBCNT)=" "_$G(^TMP($J,"SDAMA201","GETAPPT","ERROR",CNT))
86 ;
87 S OPT=0 F S OPT=$O(^TMP($J,"SDAMA201","GETAPPT",OPT)) Q:'OPT D
88 .S IBCNT=IBCNT+1
89 .I IBCNT>100 S IBT(IBCNT)="Too many to list" S OPT=9999999 Q
90 .S IBT(IBCNT)=" Outpatient Visit on "_$$DAT1^IBOUTL($G(^TMP($J,"SDAMA201","GETAPPT",OPT,1)))_" to "_$P($G(^TMP($J,"SDAMA201","GETAPPT",OPT,2)),"^",2)
91 .S CNT=CNT+1
92 I 'CNT S IBCNT=IBCNT+1,IBT(IBCNT)=" No Scheduled appointments found."
93 Q
94 ;
95INPT ; -- list inpt. treatment (admissions only)
96 N CNT S CNT=0
97 I $G(^DPT(DFN,.1))]"" S CNT=CNT+1,IBCNT=IBCNT+1,IBT(IBCNT)=" Currently an Inpatient on "_$G(^DPT(DFN,.1))
98 I $G(IBTADD) S IBCNT=IBCNT+1,IBT(IBCNT)=" Entry Added to Claims Tracking for Current Admission."
99 I $G(VAIN(1)) S CNT=CNT+1,IBCNT=IBCNT+1,IBT(IBCNT)=" Previously an inpatient on ward "_$P(VAIN(4),"^",2)_" on "_$$DAT1^IBOUTL($P(START,"."))
100 S INPT=START F S INPT=$O(^DGPM("APTT1",DFN,INPT)) Q:'INPT!(INPT>END) S DGPM=0 F S DGPM=$O(^DGPM("APTT1",DFN,INPT,DGPM)) Q:'DGPM D
101 .Q:'$G(^DGPM(DGPM,0))
102 .S IBCNT=IBCNT+1
103 .S IBT(IBCNT)=" Inpatient Admission on "_$$DAT1^IBOUTL(+^DGPM(DGPM,0),"2P")
104 .S CNT=CNT+1
105 I 'CNT S IBCNT=IBCNT+1,IBT(IBCNT)=" No Admissions found."
106 Q
107 ;
108BUFF ; -- list insurance buffer entries for the patient
109 N IBBDA,IBX,IBY,IBB40,IBB60
110 I '$$BUFFER^IBCNBU1(DFN) S IBCNT=IBCNT+1,IBT(IBCNT)=" No Insurance Buffer entries for this Patient." Q
111 ;
112 S IBBDA=0 F S IBBDA=$O(^IBA(355.33,"C",DFN,IBBDA)) Q:'IBBDA D
113 . S IBB40=$G(^IBA(355.33,IBBDA,40)),IBB60=$G(^IBA(355.33,IBBDA,60))
114 . ;
115 . S IBY=$P($G(^IBA(355.33,+IBBDA,20)),U,1),IBX=" "_$E($S(IBY'="":IBY,1:"UNKNOWN")_" ",1,16)_" "
116 . S IBX=IBX_$E($P(IBB60,"^",4)_" ",1,16)_" "
117 . S IBX=IBX_$E($S($P(IBB40,U,3)'="":$P(IBB40,U,3),$P(IBB40,U,2)'="":$P(IBB40,U,2),$P(IBB40,U,1)=0:"Ind. Plan",1:"")_" ",1,10)_" "
118 . S IBY=$P(IBB60,"^",5) S IBX=IBX_$E($S(IBY="v":"SELF",IBY="s":"SPOUSE",1:"OTHER")_" ",1,8)
119 . S IBX=IBX_$E($$DAT1^IBOUTL($P(IBB60,"^",2))_" ",1,10)_$$DAT1^IBOUTL($P(IBB60,"^",3))
120 . S IBCNT=IBCNT+1,IBT(IBCNT)=IBX
121 Q
Note: See TracBrowser for help on using the repository browser.