| [613] | 1 | IBCNSMR7 ;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
|
|---|
| 4 | DQ ; -- 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
|
|---|
| 43 | END K ^TMP("IBCNSMR7",$J)
|
|---|
| 44 | Q
|
|---|
| 45 | TRANS ;
|
|---|
| 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
|
|---|
| 73 | DTCONV(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
|
|---|
