- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRDV.m
r613 r623 1 IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;27-MAR-03 2 ;;2.0;INTEGRATED BILLING;**214,231,361,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; This routine is used to exchange insurance information between 6 ; facilities. 7 OPT ; Menu option entry point. This is used to select a patient to request 8 ; information about from the remote treating facilities. 9 N DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1 10 ; 11 ; prompt for patient 12 AGAIN S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y 13 ; 14 BACKGND ; background/tasked entry point 15 ; IBTYPE is being used as a flag to indicate this is running in background 16 ; 17 ; look up treating facilities 18 K IBT S IBT=$$TFL^IBARXMU(DFN,.IBT) 19 I IBT<1,'$D(IBTYPE) W !!,"This patient has no remote treating facilities to query." G AGAIN 20 I IBT<1 Q 21 ; 22 ; display and verify we want to do this 23 I '$D(IBTYPE) D DEM^VADPT W !!,"The patient ",VADM(1)," has the following ",IBT," remote facilitie(s)",! S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 W !?10,$P(IBT(IBX),"^",2) 24 I '$D(IBTYPE) W !!,"Do you want to perform this Remote Query" S %=1 D YN^DICN G:%'=1 AGAIN 25 ; 26 ; get ICN 27 S IBICN=$$ICN^IBARXMU(DFN) I 'IBICN,'$D(IBTYPE) W !!,"No ICN for this patient" G AGAIN 28 I 'IBICN Q 29 ; 30 ; sent off the remote queries and get back handles 31 S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 D 32 . D SEND(.IBH,IBX,IBICN,$S($D(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY")) 33 . X $S(IBH(0)'="":"S $P(IBT(IBX),U,5)=IBH(0)",1:"W:'$D(IBTYPE) !,""No handle returned for "",$P(IBT(IBX),U,2) K IBT(IBX)") 34 ; 35 ; no handles returned 36 I $D(IBT)<9,'$D(IBTYPE) W !!,"Unable to perform any remote queries.",! G AGAIN 37 I $D(IBT)<9 Q 38 ; 39 ; go through every IBT() 40 S IBP="|",IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1!($D(IBT)<9) D 41 . ; 42 . ; do I have a return data. 43 . F IBWAIT=1:1:60 W:'$D(IBTYPE) "." H 1 D CHECK(.IBR,$P(IBT(IBX),"^",5)) I $G(IBR(0))["Done" Q 44 . I $G(IBR(0))'["Done" W:'$D(IBTYPE) !!,"Unable to communicate with ",$P(IBT(IBX),U,2) Q 45 . K IBR 46 . D RETURN(.IBR,$P(IBT(IBX),"^",5)) 47 . ; 48 . ; no data returned or error message 49 . S IBRZ=$S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0))) 50 . ; 51 . ; no info to proceed 52 . I IBRZ<1 W:'$D(IBTYPE) !,"Response from ",$P(IBT(IBX),U,2),!,$P(IBRZ,"^",2) K IBT(IBX) D:IBRZ="-1^No insurance on file" FILE(0) Q 53 . ; 54 . ; received insurance info, need to file and display message 55 . W:'$D(IBTYPE) !,"Received ",$G(IBR(0))," insurance companies from ",$P(IBT(IBX),U,2) D FILE(+IBR(0)) 56 . ; 57 . S IBY=0 F S IBY=$O(IBR(IBY)) Q:IBY<1 D 58 .. F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D 59 ... ; 60 ... ; am I on the right MAP line 61 ... I $P(IBT,IBP,3)=$S(IBY#6:IBY#6,1:6) S IBZ=$P(IBR(IBY),"^",$P(IBT,IBP,4)) I $L(IBZ) D 62 .... ; 63 .... ; xecute code to change external to internal 64 .... X:$L($P(IBT,IBP,7)) $P(IBT,IBP,7) 65 .... ; 66 .... ; put the info in the array for the buffer file 67 .... S:$D(IBZ) IBB($P(IBT,IBP,5))=IBZ 68 .. ; 69 .. ; need to avoid duplicates if possible. 70 .. I $G(IBB(20.01))["MEDICARE (WNR)" S X=0 F S X=$O(^DPT(DFN,.312,X)) Q:X<1 I $P($G(^DIC(36,+$P($G(^DPT(DFN,.312,X,0)),"^"),0)),"^")["MEDICARE (WNR)" K IBB Q 71 .. Q:'$D(IBB) 72 .. ; 73 .. ; file in the buffer file & where else needed 74 .. I IBY#6=0 D 75 ... I $L($G(IBB(20.01))) D 76 .... S IBB(.14)=$$IEN^XUAF4(+IBT(IBX)) 77 .... S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB) 78 ... I '$D(IB1),$D(IBTYPE),$L($G(IBB(20.01))) D SCH^IBTUTL2(DFN,$G(IBSAVEI),$G(IBSAVEJ)):IBTYPE="TRKR",ADM^IBTUTL($G(IBSAVE1),$G(IBSAVE2),$G(IBSAVE3),$G(IBSAVE4)):IBTYPE="ADM" S IB1=1 79 ... W:'$D(IBTYPE)&($L($G(IBB(20.01)))) !,$P($G(IBB),"^")," Buffer File entry for ",$G(IBB(20.01)) 80 ... K IBB 81 ; 82 ; flag so I don't do this patient again within 90 days 83 S ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))="" 84 ; 85 Q 86 ; 87 RPC(IBD,IBICN) ; RPC entry for looking up insurance info 88 N DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ 89 S DFN=$$DFN^IBARXMU(IBICN) I 'DFN S IBD(0)="-1^ICN Not found" Q 90 D ALL^IBCNS1(DFN,"IBY",3) 91 I '$D(IBY) S IBD(0)="-1^No insurance on file" Q 92 ; set up return format 93 ; IBD(0) = # of insurance companies 94 S IBD(0)=$G(IBY(0)) 95 ; 96 ; where n starts at 1 and increments to 7 for each insurance company 97 ; IBD(n) = 355.33, zero node format 98 ; IBD(n+1) = 355.33, 20 node format 99 ; IBD(n+2) = 355.33, 21 node format 100 ; IBD(n+3) = 355.33, 40 node format 101 ; IBD(n+4) = 355.33, 60 node format 102 ; IBD(n+5) = 355.33, 61 node format 103 ; IBD(n+6) = 355.33, 62 node format 104 ; 105 S IBP="|" 106 S IBI=0 F S IBI=$O(IBY(IBI)) Q:IBI<1 F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D 107 . S IBZ=$P($G(IBY(IBI,+IBT)),"^",$P(IBT,IBP,2)) ; set the existing data 108 . I $L($P(IBT,IBP,6)) X $P(IBT,IBP,6) ; output transform 109 . S $P(IBD(IBI-1*7+$P(IBT,IBP,3)),"^",$P(IBT,IBP,4))=IBZ ; set data IBD 110 Q 111 ; 112 MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file 113 ; format is: node number | piece | extract node | extract piece 114 ; | 355.33 field number | format out code (if any) 115 ; | format in code (if any) 116 ; the extract nodes will be sequential to match buffer file DD 117 ;;0|1|2|1|20.01|N Z X "F Z=0,.11,.13 S IBY(IBI,36+Z)=$G(^DIC(36,IBZ,Z))" S IBZ=$P(IBY(IBI,36),"^");ins co name 118 ;;0|2|5|4|60.04;subscriber id 119 ;;0|4|5|3|60.03;experation date 120 ;;0|6|5|5|60.05;who's insurance 121 ;;0|8|5|2|60.02;effective date 122 ;;0|16|5|6|60.06;pt relationship to insured 123 ;;0|17|5|7|60.07;name of insured 124 ;;0|20|5|12|60.12;coordination of benefits 125 ;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified 126 ;;1|9|1|3|.03;source of information 127 ;;2|1|6|5|61.05;send bill to employer 128 ;;2|2|6|6|61.06;employer claims street address (line 1) 129 ;;2|3|6|7|61.07;employer claims street address line 2 130 ;;2|4|6|8|61.08;employer claims street address line 3 131 ;;2|5|6|9|61.09;employer claims city 132 ;;2|6|6|10|61.1|S IBZ=$$EXTERNAL^DILFD(2.312,2.06,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;employer claims state 133 ;;2|7|6|11|61.11;employer claims zip code 134 ;;2|8|6|12|61.12;employer claims phone 135 ;;2|10|6|1|61.01;esghp 136 ;;2|11|6|3|61.03;employment status 137 ;;2|12|6|4|61.04;retirement date 138 ;;3|1|5|8|60.08;insured's dob 139 ;;3|5|5|9|60.09;insured's ssn 140 ;;3|12|5|13|60.13;insured's sex 141 ;;4|1|5|10|60.1;primary care provider 142 ;;4|2|5|11|60.11;primary provider phone 143 ;;5|1|7|1|62.01;patient id 144 ;;355.3|2|4|1|40.01;is this a group policy 145 ;;355.3|3|4|2|40.02;group name 146 ;;355.3|4|4|3|40.03;group number 147 ;;355.3|5|4|4|40.04;(is) utilization required 148 ;;355.3|6|4|5|40.05;(is) pre-certification required 149 ;;355.3|7|4|7|40.07;exclude pre-existing condition 150 ;;355.3|8|4|8|40.08;benefits assignable 151 ;;355.3|9|4|9|40.09;type of plan 152 ;;355.3|12|4|6|40.06;ambulatory care certification 153 ;;36|2|2|5|20.05;reimburse 154 ;;36.11|1|3|1|21.01;street address line 1 155 ;;36.11|2|3|2|21.02;street address line 2 156 ;;36.11|3|3|3|21.03;street address line 3 157 ;;36.11|4|3|4|21.04;city 158 ;;36.11|5|3|5|21.05|S IBZ=$$EXTERNAL^DILFD(36,.115,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;state 159 ;;36.11|6|3|6|21.06;zip code 160 ;;36.13|1|2|2|20.02;phone number 161 ;;36.13|2|2|3|20.03;billing phone number 162 ;;36.13|3|2|4|20.04;precertification phone number 163 ;; 164 ; 165 SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries 166 D EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN) 167 Q 168 ; 169 CHECK(IBR,IBH) ; called to check the return status of an RPC 170 D RPCCHK^XWB2HL7(.IBR,IBH) 171 Q 172 ; 173 RETURN(IBR,IBH) ; called to get the return data and clear the broker 174 N IBZ 175 D RTNDATA^XWBDRPC(.IBR,IBH),CLEAR^XWBDRPC(.IBZ,IBH) 176 Q 177 ; 178 TASK ; queue off task job 179 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE 180 S ZTRTN="BACKGND^IBCNRDV",ZTDESC="Query Remote Facilities for Insurance",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT),(ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))="" D ^%ZTLOAD 181 Q 182 ; 183 TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry 184 N IBTYPE,IBT 185 Q:$D(^IBT(356,"ARDV",DFN)) ; have already done recently 186 Q:'$$TFL^IBARXMU(DFN,.IBT) ; no remote facilities 187 S IBTYPE="TRKR" D 188 . I DUZ=.5 N DUZ S DUZ=+$G(IBDUZ),DUZ(2)=+$$SITE^VASITE 189 . D TASK 190 Q 191 ; 192 ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry 193 N IBTYPE S IBTYPE="ADM" D TASK 194 Q 195 ; 196 FILE(IBX) ; updates data into the log file 197 ;IBX = number of insurance co's found 198 N DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR 199 S IBM=$E($$DT^XLFDT,1,5)_"00",DA=+$O(^IBA(355.34,"B",IBM,0)) 200 I 'DA K DA L +^IBA(355.34,"B",IBM):10 S X=IBM,DIC="^IBA(355.34,",DIC(0)="F" D FILE^DICN S DA=+Y L -^IBA(355.34,"B",IBM) 201 L +^IBA(355.34,DA):10 202 S IBZ=^IBA(355.34,DA,0),DIE="^IBA(355.34," 203 S DR=".02///"_($P(IBZ,"^",2)+1)_";.03///"_($P(IBZ,"^",3)+IBX) D ^DIE 204 L -^IBA(355.34,DA) 205 Q 1 IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV;27-MAR-03 2 ;;2.0;INTEGRATED BILLING;**214,231,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; This routine is used to exchange insurance information between 6 ; facilities. 7 OPT ; Menu option entry point. This is used to select a patient to request 8 ; information about from the remote treating facilities. 9 N DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1 10 ; 11 ; prompt for patient 12 AGAIN S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y 13 ; 14 BACKGND ; background/tasked entry point 15 ; IBTYPE is being used as a flag to indicate this is running in background 16 ; 17 ; look up treating facilities 18 K IBT S IBT=$$TFL^IBARXMU(DFN,.IBT) 19 I IBT<1,'$D(IBTYPE) W !!,"This patient has no remote treating facilities to query." G AGAIN 20 I IBT<1 Q 21 ; 22 ; display and verify we want to do this 23 I '$D(IBTYPE) D DEM^VADPT W !!,"The patient ",VADM(1)," has the following ",IBT," remote facilitie(s)",! S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 W !?10,$P(IBT(IBX),"^",2) 24 I '$D(IBTYPE) W !!,"Do you want to perform this Remote Query" S %=1 D YN^DICN G:%'=1 AGAIN 25 ; 26 ; get ICN 27 S IBICN=$$ICN^IBARXMU(DFN) I 'IBICN,'$D(IBTYPE) W !!,"No ICN for this patient" G AGAIN 28 I 'IBICN Q 29 ; 30 ; sent off the remote queries and get back handles 31 S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 D 32 . D SEND(.IBH,IBX,IBICN,$S($D(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY")) 33 . X $S(IBH(0)'="":"S $P(IBT(IBX),U,5)=IBH(0)",1:"W:'$D(IBTYPE) !,""No handle returned for "",$P(IBT(IBX),U,2) K IBT(IBX)") 34 ; 35 ; no handles returned 36 I $D(IBT)<9,'$D(IBTYPE) W !!,"Unable to perform any remote queries.",! G AGAIN 37 I $D(IBT)<9 Q 38 ; 39 ; go through every IBT() 40 S IBP="|",IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1!($D(IBT)<9) D 41 . ; 42 . ; do I have a return data. 43 . F IBWAIT=1:1:60 W:'$D(IBTYPE) "." H 1 D CHECK(.IBR,$P(IBT(IBX),"^",5)) I $G(IBR(0))["Done" Q 44 . I $G(IBR(0))'["Done" W:'$D(IBTYPE) !!,"Unable to communicate with ",$P(IBT(IBX),U,2) Q 45 . K IBR 46 . D RETURN(.IBR,$P(IBT(IBX),"^",5)) 47 . ; 48 . ; no data returned or error message 49 . S IBRZ=$S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0))) 50 . ; 51 . ; no info to proceed 52 . I IBRZ<1 W:'$D(IBTYPE) !,"Response from ",$P(IBT(IBX),U,2),!,$P(IBRZ,"^",2) K IBT(IBX) D:IBRZ="-1^No insurance on file" FILE(0) Q 53 . ; 54 . ; received insurance info, need to file and display message 55 . W:'$D(IBTYPE) !,"Received ",$G(IBR(0))," insurance companies from ",$P(IBT(IBX),U,2) D FILE(+IBR(0)) 56 . ; 57 . S IBY=0 F S IBY=$O(IBR(IBY)) Q:IBY<1 D 58 .. F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D 59 ... ; 60 ... ; am I on the right MAP line 61 ... I $P(IBT,IBP,3)=$S(IBY#6:IBY#6,1:6) S IBZ=$P(IBR(IBY),"^",$P(IBT,IBP,4)) I $L(IBZ) D 62 .... ; 63 .... ; xecute code to change external to internal 64 .... X:$L($P(IBT,IBP,7)) $P(IBT,IBP,7) 65 .... ; 66 .... ; put the info in the array for the buffer file 67 .... S:$D(IBZ) IBB($P(IBT,IBP,5))=IBZ 68 .. ; 69 .. ; need to avoid duplicates if possible. 70 .. I $G(IBB(20.01))["MEDICARE (WNR)" S X=0 F S X=$O(^DPT(DFN,.312,X)) Q:X<1 I $P($G(^DIC(36,+$P($G(^DPT(DFN,.312,X,0)),"^"),0)),"^")["MEDICARE (WNR)" K IBB Q 71 .. Q:'$D(IBB) 72 .. ; 73 .. ; file in the buffer file & where else needed 74 .. I IBY#6=0 D 75 ... I $L($G(IBB(20.01))) D 76 .... S IBB(.14)=$$IEN^XUAF4(+IBT(IBX)) 77 .... S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB) 78 ... I '$D(IB1),$D(IBTYPE),$L($G(IBB(20.01))) D SCH^IBTUTL2(DFN,$G(IBSAVEI),$G(IBSAVEJ)):IBTYPE="TRKR",ADM^IBTUTL($G(IBSAVE1),$G(IBSAVE2),$G(IBSAVE3),$G(IBSAVE4)):IBTYPE="ADM" S IB1=1 79 ... W:'$D(IBTYPE)&($L($G(IBB(20.01)))) !,$P($G(IBB),"^")," Buffer File entry for ",$G(IBB(20.01)) 80 ... K IBB 81 ; 82 ; flag so I don't do this patient again within 90 days 83 S ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))="" 84 ; 85 Q 86 ; 87 RPC(IBD,IBICN) ; RPC entry for looking up insurance info 88 N DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ 89 S DFN=$$DFN^IBARXMU(IBICN) I 'DFN S IBD(0)="-1^ICN Not found" Q 90 D ALL^IBCNS1(DFN,"IBY",3) 91 I '$D(IBY) S IBD(0)="-1^No insurance on file" Q 92 ; set up return format 93 ; IBD(0) = # of insurance companies 94 S IBD(0)=$G(IBY(0)) 95 ; 96 ; where n starts at 1 and increments 6 for each insurance company 97 ; IBD(n) = 355.33, zero node format 98 ; IBD(n+1) = 355.33, 20 node format 99 ; IBD(n+2) = 355.33, 21 node format 100 ; IBD(n+3) = 355.33, 40 node format 101 ; IBD(n+4) = 355.33, 60 node format 102 ; IBD(n+5) = 355.33, 61 node format 103 ; 104 S IBP="|" 105 S IBI=0 F S IBI=$O(IBY(IBI)) Q:IBI<1 F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D 106 . S IBZ=$P($G(IBY(IBI,+IBT)),"^",$P(IBT,IBP,2)) ; set the existing data 107 . I $L($P(IBT,IBP,6)) X $P(IBT,IBP,6) ; output transform 108 . S $P(IBD(IBI-1*6+$P(IBT,IBP,3)),"^",$P(IBT,IBP,4))=IBZ ; set data IBD 109 Q 110 ; 111 MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file 112 ; format is: node number | piece | extract node | extract piece 113 ; | 355.33 field number | format out code (if any) 114 ; | format in code (if any) 115 ; the extract nodes will be sequential to match buffer file DD 116 ;;0|1|2|1|20.01|N Z X "F Z=0,.11,.13 S IBY(IBI,36+Z)=$G(^DIC(36,IBZ,Z))" S IBZ=$P(IBY(IBI,36),"^");ins co name 117 ;;0|2|5|4|60.04;subscriber id 118 ;;0|4|5|3|60.03;experation date 119 ;;0|6|5|5|60.05;who's insurance 120 ;;0|8|5|2|60.02;effective date 121 ;;0|16|5|6|60.06;pt relationship to insured 122 ;;0|17|5|7|60.07;name of insured 123 ;;0|20|5|12|60.12;coordination of benefits 124 ;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified 125 ;;1|9|1|3|.03;source of information 126 ;;2|1|6|5|61.05;send bill to employer 127 ;;2|2|6|6|61.06;employer claims street address (line 1) 128 ;;2|3|6|7|61.07;employer claims street address line 2 129 ;;2|4|6|8|61.08;employer claims street address line 3 130 ;;2|5|6|9|61.09;employer claims city 131 ;;2|6|6|10|61.1|S IBZ=$$EXTERNAL^DILFD(2.312,2.06,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;employer claims state 132 ;;2|7|6|11|61.11;employer claims zip code 133 ;;2|8|6|12|61.12;employer claims phone 134 ;;2|10|6|1|61.01;esghp 135 ;;2|11|6|3|61.03;employment status 136 ;;2|12|6|4|61.04;retirement date 137 ;;3|1|5|8|60.08;insured's dob 138 ;;3|5|5|9|60.09;insured's ssn 139 ;;3|12|5|13|60.13;insured's sex 140 ;;4|1|5|10|60.1;primary care provider 141 ;;4|2|5|11|60.11;primary provider phone 142 ;;355.3|2|4|1|40.01;is this a group policy 143 ;;355.3|3|4|2|40.02;group name 144 ;;355.3|4|4|3|40.03;group number 145 ;;355.3|5|4|4|40.04;(is) utilization required 146 ;;355.3|6|4|5|40.05;(is) pre-certification required 147 ;;355.3|7|4|7|40.07;exclude pre-existing condition 148 ;;355.3|8|4|8|40.08;benefits assignable 149 ;;355.3|9|4|9|40.09;type of plan 150 ;;355.3|12|4|6|40.06;ambulatory care certification 151 ;;36|2|2|5|20.05;reimburse 152 ;;36.11|1|3|1|21.01;street address line 1 153 ;;36.11|2|3|2|21.02;street address line 2 154 ;;36.11|3|3|3|21.03;street address line 3 155 ;;36.11|4|3|4|21.04;city 156 ;;36.11|5|3|5|21.05|S IBZ=$$EXTERNAL^DILFD(36,.115,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;state 157 ;;36.11|6|3|6|21.06;zip code 158 ;;36.13|1|2|2|20.02;phone number 159 ;;36.13|2|2|3|20.03;billing phone number 160 ;;36.13|3|2|4|20.04;precertification phone number 161 ;; 162 ; 163 SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries 164 D EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN) 165 Q 166 ; 167 CHECK(IBR,IBH) ; called to check the return status of an RPC 168 D RPCCHK^XWB2HL7(.IBR,IBH) 169 Q 170 ; 171 RETURN(IBR,IBH) ; called to get the return data and clear the broker 172 N IBZ 173 D RTNDATA^XWBDRPC(.IBR,IBH),CLEAR^XWBDRPC(.IBZ,IBH) 174 Q 175 ; 176 TASK ; queue off task job 177 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE 178 S ZTRTN="BACKGND^IBCNRDV",ZTDESC="Query Remote Facilities for Insurance",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT),(ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))="" D ^%ZTLOAD 179 Q 180 ; 181 TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry 182 N IBTYPE,IBT 183 Q:$D(^IBT(356,"ARDV",DFN)) ; have already done recently 184 Q:'$$TFL^IBARXMU(DFN,.IBT) ; no remote facilities 185 S IBTYPE="TRKR" D 186 . I DUZ=.5 N DUZ S DUZ=+$G(IBDUZ),DUZ(2)=+$$SITE^VASITE 187 . D TASK 188 Q 189 ; 190 ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry 191 N IBTYPE S IBTYPE="ADM" D TASK 192 Q 193 ; 194 FILE(IBX) ; updates data into the log file 195 ;IBX = number of insurance co's found 196 N DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR 197 S IBM=$E($$DT^XLFDT,1,5)_"00",DA=+$O(^IBA(355.34,"B",IBM,0)) 198 I 'DA K DA L +^IBA(355.34,"B",IBM):10 S X=IBM,DIC="^IBA(355.34,",DIC(0)="F" D FILE^DICN S DA=+Y L -^IBA(355.34,"B",IBM) 199 L +^IBA(355.34,DA):10 200 S IBZ=^IBA(355.34,DA,0),DIE="^IBA(355.34," 201 S DR=".02///"_($P(IBZ,"^",2)+1)_";.03///"_($P(IBZ,"^",3)+IBX) D ^DIE 202 L -^IBA(355.34,DA) 203 Q
Note:
See TracChangeset
for help on using the changeset viewer.
