source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSMR7.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1IBCNSMR7 ;ALB/TJK - MRA EXTRACT ;2/20/01 9:55 AM ;2/14/01 10:25 AM
2 ;;2.0;INTEGRATED BILLING;**146**;21-MAR-94
3 ;Compiles MRA Extract data
4DQ ; -- entry point from task manager
5 N IBINSCO,DFN,DATACNT,SSN,PATNM,DOB,DIQ,DA,DIC,DR,ININSCON,INS,IBTR
6 N IBINSCON,Y2 K ^TMP("IBCNSMR7",$J)
7 ;Loop through list of insurance companies involved
8 S IBINSCO=0
9 F S IBINSCO=$O(^IBE(350.9,1,99,"B",IBINSCO)) Q:'IBINSCO D
10 .S DIC=36,DA=IBINSCO,DR=.01,DIQ="INS(" D EN^DIQ1
11 .S IBINSCON=INS(36,IBINSCO,.01) K INS
12 .;Get subscribers for insurance company
13 .S DFN=0 F S DFN=$O(^DPT("AB",IBINSCO,DFN)) Q:'DFN D
14 ..; Gather patient infor
15 ..D ^VADPT S PATNM=VADM(1),SSN=+VADM(2),DOB=$P(VADM(3),"^")
16 ..K VADM
17 ..N IBN,IBX,IBCNT,IBFLG,Y,Y1,CHG,TCHG,ARBILL,EVDATE,PAREVENT,NEV
18 ..N IBCHDT
19 ..S NEV="" F S NEV=$O(^IB("AFDT",DFN,NEV)) Q:'NEV I -NEV'>IBAEND S PAREVENT=0 F S PAREVENT=$O(^IB("AFDT",DFN,NEV,PAREVENT)) Q:'PAREVENT D
20 ...S (TCHG,IBN,IBFLG,IBCNT,ARBILL)=0,EVDATE=-NEV
21 ...S IBN=0 F S IBN=$O(^IB("AF",PAREVENT,IBN)) Q:'IBN D
22 ....Q:'$D(^IB(IBN,0)) S IBX=^(0)
23 ....Q:$P(IBX,"^",8)["ADMISSION"
24 ....Q:$P(IBX,"^",10)
25 ....Q:$P(IBX,"^",11)=""
26 ....Q:$P(IBX,"^",17)<IBABEG
27 ....N DIC,Y
28 ....S DIC=430,X=$P(IBX,"^",11),DIC(0)="MZ" D ^DIC Q:'Y
29 ....I ($P(Y(0),U,8)=39)!($P(Y(0),U,8)=26) Q
30 ....S ARBILL=+Y
31 ....Q:$D(^TMP("IBCNSMR7",$J,"BILL",ARBILL))
32 ....S (Y,Y2)=0
33 ....;check for valid insurance
34 ....F S Y=$O(^DPT(DFN,.312,"B",IBINSCO,Y)) Q:'Y S Y1=$G(^DPT(DFN,.312,Y,0)),Y2=$$CHK^IBCNS1(Y1,EVDATE,2) Q:Y2
35 ....Q:'Y2
36 ....D TRANS
37 ....Q
38 ...Q
39 ..Q
40 .Q
41 ;calls IBCSNMR8 to make .dat file and send completion message to user
42 K ^TMP("IBCNSMR7",$J,"BILL") D ^IBCNSMR8
43END K ^TMP("IBCNSMR7",$J)
44 Q
45TRANS ;
46 N T1,T0,TRAN,TDATA,TTYPE,TAMT,TCNT,IBCHDT,PAYM,DATA,EVNO,TOTP,PDATE
47 S (TRAN,TOTP)=0
48 F S TRAN=$O(^PRCA(433,"C",ARBILL,TRAN)) Q:'TRAN D
49 .S (IBCHDT,PDATE)=0
50 .S T0=$G(^PRCA(433,TRAN,0)),T1=$G(^(1))
51 .Q:$P(T0,"^",4)'=2
52 .S TTYPE=$P(T1,"^",2)
53 .S TAMT=$P(T1,"^",5)
54 .I (TTYPE=2)!(TTYPE=34) S TOTP=TOTP+TAMT,PDATE=+T1
55 .S EVNO=$O(^IB("AT",TRAN,0)) S:'EVNO IBX=""
56 .I EVNO D
57 ..S IBX=$G(^IB(EVNO,0))
58 ..S IBCHDT=$P(IBX,"^",17),IBX=$P(IBX,"^")
59 ..Q
60 .I 'IBCHDT S IBCHDT=+T1
61 .;sets data in global ^TMP("IBCNSMR7",$J,"DATA")
62 .S DATACNT=$G(DATACNT)+1
63 .S DATA=SITE_TRAN_"^"_PATNM_"^"_SSN_"^"_IBINSCON_"^"_$$DTCONV(IBCHDT)
64 .S DATA=DATA_"^"_$J(TAMT,0,2)_"^"_$S(PDATE:$$DTCONV(PDATE),1:"")
65 .S DATA=DATA_"^"_$S(PDATE:$J(TAMT,0,2),1:"")_"^"_$$DTCONV(DOB)_"^"_SITE
66 .S DATA=DATA_"^"_$P(^PRCA(430,ARBILL,0),"^")_"^"_IBX
67 .S DATA=DATA_"^"_$P(^PRCA(430.3,TTYPE,0),"^")_"^"
68 .I '$O(^PRCA(433,"C",ARBILL,TRAN)) S DATA=DATA_$J(TOTP,0,2)
69 .S ^TMP("IBCNSMR7",$J,"DATA",DATACNT)=DATA
70 .Q
71 S ^TMP("IBCNSMR7",$J,"BILL",ARBILL)=""
72 Q
73DTCONV(DATE) ;Converts dates from Fileman to Oracle format
74 N MON
75 S MON=+$E(DATE,4,5),MON=$S(MON=1:"JAN",MON=2:"FEB",MON=3:"MAR",MON=4:"APR",MON=5:"MAY",MON=6:"JUN",MON=7:"JUL",MON=8:"AUG",MON=9:"SEP",MON=10:"OCT",MON=11:"NOV",1:"DEC")
76 S DATE=$E(DATE,6,7)_"-"_MON_"-"_($E(DATE,1,3)+1700)
77 Q DATE
Note: See TracBrowser for help on using the repository browser.