- IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;27-MAR-03
- ;;2.0;INTEGRATED BILLING;**214,231,361,371,452,593,631,664,763**;21-MAR-94;Build 29
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; This routine is used to exchange insurance information between
- ; facilities.
- OPT ; Menu option entry point. This is used to select a patient to request
- ; information about from the remote treating facilities.
- ;IB*2.0*664/TAZ - Add CTR to New List
- N CTR,DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBFASTXT,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1
- ;
- ; prompt for patient
- AGAIN S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y
- ;
- BACKGND ; background/tasked entry point
- ; IBTYPE is being used as a flag to indicate this is running in background
- ;
- ;IB*763/TAZ - Check Insurance Import Enabled flag and quit if not enabled.
- ; for background jobs only
- I $D(IBTYPE),'$$GET1^DIQ(350.9,"1,",54.01,"I") Q
- ;
- ; look up treating facilities
- K IBT S IBT=$$TFL^IBARXMU(DFN,.IBT)
- I IBT<1,'$D(IBTYPE) W !!,"This patient has no remote treating facilities to query." G AGAIN
- I IBT<1 Q
- ;
- ; display and verify we want to do this
- 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)
- I '$D(IBTYPE) W !!,"Do you want to perform this Remote Query" S %=1 D YN^DICN G:%'=1 AGAIN
- ;
- ; get ICN
- S IBICN=$$ICN^IBARXMU(DFN) I 'IBICN,'$D(IBTYPE) W !!,"No ICN for this patient" G AGAIN
- I 'IBICN Q
- ;
- ; sent off the remote queries and get back handles
- S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 D
- . D SEND(.IBH,IBX,IBICN,$S($D(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY"))
- . 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)")
- ;
- ; no handles returned
- I $D(IBT)<9,'$D(IBTYPE) W !!,"Unable to perform any remote queries.",! G AGAIN
- I $D(IBT)<9 Q
- ;
- ;Create Duplicate Check Index
- ;IB*2.0*664/TAZ - Only build index for Background calls
- I $D(IBTYPE) D INDEX(DFN)
- ;
- ; go through every IBT()
- S IBP="|",IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1!($D(IBT)<9) D
- . ;
- . ; do I have a return data.
- . F IBWAIT=1:1:60 W:'$D(IBTYPE) "." H 1 D CHECK(.IBR,$P(IBT(IBX),"^",5)) I $G(IBR(0))["Done" Q
- . I $G(IBR(0))'["Done" W:'$D(IBTYPE) !!,"Unable to communicate with ",$P(IBT(IBX),U,2) Q
- . K IBR
- . D RETURN(.IBR,$P(IBT(IBX),"^",5))
- . ;
- . ; no data returned or error message
- . S IBRZ=$S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0)))
- . ;
- . ; no info to proceed
- . 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
- . ;
- . ; received insurance info, need to file and display message
- . W:'$D(IBTYPE) !,"Received ",$G(IBR(0))," insurance companies from ",$P(IBT(IBX),U,2) D FILE(+IBR(0))
- . ;
- . S IBY=0 F S IBY=$O(IBR(IBY)) Q:IBY<1 D
- .. F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D
- ... ;
- ... ; am I on the right MAP line
- ... ;IB*2.0*631/TAZ - Insurance data comes in multiples of 7
- ... I $P(IBT,IBP,3)=$S(IBY#7:IBY#7,1:7) S IBZ=$P(IBR(IBY),"^",$P(IBT,IBP,4)) I $L(IBZ) D
- .... ;
- .... ; execute code to change external to internal
- .... X:$L($P(IBT,IBP,7)) $P(IBT,IBP,7)
- .... ;
- .... ; put the info in the array for the buffer file
- .... S:$D(IBZ) IBB($P(IBT,IBP,5))=IBZ
- .. ;
- .. ; file in the buffer file & where else needed
- .. ;IB*2.0*631/TAZ - File on the 7th multiple line (i.e. 7,14,21...)
- .. I IBY#7=0 D
- ... I $L($G(IBB(20.01))) D
- .... N IBOK S IBOK=1
- .... S IBB(.14)=$$IEN^XUAF4(+IBT(IBX))
- .... S IBB(.03)=$O(^IBE(355.12,"C","INSURANCE IMPORT",""))
- .... D VCHECK(.IBB) I 'IBOK Q
- .... ;IB*2.0*664/TAZ - Set up ^TMP Array for input to ListMan screen if interactive
- .... I '$D(IBTYPE) D Q
- ..... S CTR=$O(^TMP($J,"IBCNRDV",""),-1)+1
- ..... M ^TMP($J,"IBCNRDV",CTR)=IBB
- .... S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB)
- .... ;IB*2.0*664/TAZ - Moved the following line into this dotted Do struction since it only executed if $L($G(IBB(20.01)))
- .... I '$D(IB1),$D(IBTYPE) 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
- ... K IBB
- ;
- ;IB*2.0*664/TAZ - Branch to ListMan screen if interactive
- I '$D(IBTYPE),$D(^TMP($J,"IBCNRDV")) H 3 D EN^IBCNRDV1
- ;
- ; flag so I don't do this patient again within 90 days
- S ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))=""
- ;
- ; Clean up ^TMP global
- K ^TMP($J,"IBCNRDV")
- ;
- Q
- ;
- VCHECK(IBB) ; Check to make sure the record is not duplicate and passes validity check.
- ;
- ;Check for duplicates
- ;IB*2.0*664/TAZ - Only check for duplicates when processing in background
- I $D(IBTYPE),$$DUP(.IBB) S IBOK=0 G VCHECKX
- ; Validate entries to insure we are only getting the data we want.
- I '$$VALID(.IBB) S IBOK=0 G VCHECKX
- ;IB*2.0*664/TAZ - Only add to INDEX for background processing
- I '$D(IBTYPE) G VCHECKX
- ;Add to index
- N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
- S IBINSNM=$G(IBB(20.01)) I IBINSNM']"" S IBINSNM=" "
- S IBGRP=$G(IBB(40.03)) I IBGRP']"" S IBGRP=" "
- S IBSUBID=$G(IBB(60.04)) I IBSUBID']"" S IBSUBID=" "
- S IBNAME=$P($G(IBB(60.07))," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
- S IBDOB=$G(IBB(60.08)) I 'IBDOB S IBDOB=" "
- S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
- ;
- VCHECKX ;
- Q
- ;
- INDEX(DFN) ;
- K ^TMP("IBCNRDV",$J)
- N IBBUFDA,IBIEN
- ; From Buffer
- S IBBUFDA=0
- F S IBBUFDA=$O(^IBA(355.33,"C",DFN,IBBUFDA)) Q:'IBBUFDA D
- . N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
- . S IBINSNM=$$GET1^DIQ(355.33,IBBUFDA_",","INSURANCE COMPANY NAME") I IBINSNM']"" S IBINSNM=" "
- . S IBGRP=$$GET1^DIQ(355.33,IBBUFDA_",","GROUP NUMBER") I IBGRP']"" S IBGRP=" "
- . S IBSUBID=$$GET1^DIQ(355.33,IBBUFDA_",","SUBSCRIBER ID") I IBSUBID']"" S IBSUBID=" "
- . S IBNAME=$P($$GET1^DIQ(355.33,IBBUFDA_",","NAME OF INSURED")," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
- . S IBDOB=$$GET1^DIQ(355.33,IBBUFDA_",","INSURED'S DOB","I") I 'IBDOB S IBDOB=" "
- . S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
- ; From active Insurance
- K IBINS
- D ALL^IBCNS1(DFN,"IBINS",2) ; Get all active insurance
- I $G(IBINS(0)) S IBIEN=0 F S IBIEN=$O(IBINS(IBIEN)) Q:'IBIEN D
- . N IBDOB,IBGRP,IBINSIEN,IBINSNM,IBNAME,IBSUBID
- . S IBINSIEN=+$P($G(IBINS(IBIEN,0)),U,1)
- . S IBINSNM=$$GET1^DIQ(36,IBINSIEN_",","NAME") I IBINSNM']"" S IBINSNM=" "
- . S IBGRP=$P($G(IBINS(IBIEN,355.3)),U,4) I IBGRP']"" S IBGRP=" "
- . S IBSUBID=$P($G(IBINS(IBIEN,7)),U,2) I IBSUBID']"" S IBSUBID=" "
- . S IBNAME=$P($P($G(IBINS(IBIEN,7)),U)," ") I IBNAME']"" S IBNAME=" "
- . S IBDOB=$P($G(IBINS(IBIEN,3)),U) I 'IBDOB S IBDOB=" "
- . S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
- K IBINS
- ;
- Q
- ;
- RPC(IBD,IBICN) ; RPC entry for looking up insurance info
- N DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ
- S DFN=$$DFN^IBARXMU(IBICN) I 'DFN S IBD(0)="-1^ICN Not found" Q
- D ALL^IBCNS1(DFN,"IBY",3)
- I '$D(IBY) S IBD(0)="-1^No insurance on file" Q
- ; set up return format
- ; IBD(0) = # of insurance companies
- S IBD(0)=$G(IBY(0))
- ;
- ; where n starts at 1 and increments to 7 for each insurance company
- ; IBD(n) = 355.33, zero node format
- ; IBD(n+1) = 355.33, 20 node format
- ; IBD(n+2) = 355.33, 21 node format
- ; IBD(n+3) = 355.33, 40 node format
- ; IBD(n+4) = 355.33, 60 node format
- ; IBD(n+5) = 355.33, 61 node format
- ; IBD(n+6) = 355.33, 62 node format
- ;
- S IBP="|"
- 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
- . S IBZ=$P($G(IBY(IBI,+IBT)),"^",$P(IBT,IBP,2)) ; set the existing data
- . I $L($P(IBT,IBP,6)) X $P(IBT,IBP,6) ; output transform
- . S $P(IBD(IBI-1*7+$P(IBT,IBP,3)),"^",$P(IBT,IBP,4))=IBZ ; set data IBD
- Q
- ;
- MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file
- ; format is: node number | piece | extract node | extract piece
- ; | 355.33 field number | format out code (if any)
- ; | format in code (if any)
- ; the extract nodes will be sequential to match buffer file DD
- ;;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
- ;;0|2|5|4|60.04;subscriber id
- ;;0|4|5|3|60.03;experation date
- ;;0|6|5|5|60.05;who's insurance
- ;;0|8|5|2|60.02;effective date
- ;;0|16|5|6|60.06;pt relationship to insured
- ;;0|17|5|7|60.07;name of insured
- ;;0|20|5|12|60.12;coordination of benefits
- ;;1|1|1|1|.01||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date entered ;IB*593/TAZ
- ;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified
- ;;1|9|1|3|.03||S IBZ=$O(^IBE(355.12,"C","INSURANCE IMPORT",""));source of information ; Patch #593 Set to INSPT
- ;;2|1|6|5|61.05;send bill to employer
- ;;2|2|6|6|61.06;employer claims street address (line 1)
- ;;2|3|6|7|61.07;employer claims street address line 2
- ;;2|4|6|8|61.08;employer claims street address line 3
- ;;2|5|6|9|61.09;employer claims city
- ;;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
- ;;2|7|6|11|61.11;employer claims zip code
- ;;2|8|6|12|61.12;employer claims phone
- ;;2|10|6|1|61.01;esghp
- ;;2|11|6|3|61.03;employment status
- ;;2|12|6|4|61.04;retirement date
- ;;3|1|5|8|60.08;insured's dob
- ;;3|5|5|9|60.09;insured's ssn
- ;;3|12|5|13|60.13;insured's sex
- ;;4|1|5|10|60.1;primary care provider
- ;;4|2|5|11|60.11;primary provider phone
- ;;4|5|5|15|60.15;pharmacy relationship code
- ;;4|6|5|16|60.16;pharmacy person code
- ;;5|1|7|1|62.01;patient id
- ;;355.3|2|4|1|40.01;is this a group policy
- ;;355.3|3|4|2|40.02;group name
- ;;355.3|4|4|3|40.03;group number
- ;;355.3|5|4|4|40.04;(is) utilization required
- ;;355.3|6|4|5|40.05;(is) pre-certification required
- ;;355.3|7|4|7|40.07;exclude pre-existing condition
- ;;355.3|8|4|8|40.08;benefits assignable
- ;;355.3|9|4|9|40.09;type of plan
- ;;355.3|12|4|6|40.06;ambulatory care certification
- ;;36|2|2|5|20.05;reimburse
- ;;36.11|1|3|1|21.01;street address line 1
- ;;36.11|2|3|2|21.02;street address line 2
- ;;36.11|3|3|3|21.03;street address line 3
- ;;36.11|4|3|4|21.04;city
- ;;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
- ;;36.11|6|3|6|21.06;zip code
- ;;36.13|1|2|2|20.02;phone number
- ;;36.13|2|2|3|20.03;billing phone number
- ;;36.13|3|2|4|20.04;precertification phone number
- ;;
- ;
- SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries
- D EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN)
- Q
- ;
- CHECK(IBR,IBH) ; called to check the return status of an RPC
- D RPCCHK^XWB2HL7(.IBR,IBH)
- Q
- ;
- RETURN(IBR,IBH) ; called to get the return data and clear the broker
- N IBZ
- D RTNDATA^XWBDRPC(.IBR,IBH),CLEAR^XWBDRPC(.IBZ,IBH)
- Q
- ;
- TASK ; queue off task job
- N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
- S ZTRTN="BACKGND^IBCNRDV",ZTDESC="Query Remote Facilities for Insurance",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT),(ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))="" D ^%ZTLOAD
- Q
- ;
- TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry
- N IBTYPE,IBT
- Q:$D(^IBT(356,"ARDV",DFN)) ; have already done recently
- Q:'$$TFL^IBARXMU(DFN,.IBT) ; no remote facilities
- S IBTYPE="TRKR" D
- . I DUZ=.5 N DUZ S DUZ=+$G(IBDUZ),DUZ(2)=+$$SITE^VASITE
- . D TASK
- Q
- ;
- ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry
- N IBTYPE S IBTYPE="ADM" D TASK
- Q
- ;
- FILE(IBX) ; updates data into the log file
- ;IBX = number of insurance co's found
- N DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR
- S IBM=$E($$DT^XLFDT,1,5)_"00",DA=+$O(^IBA(355.34,"B",IBM,0))
- 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)
- L +^IBA(355.34,DA):10
- S IBZ=^IBA(355.34,DA,0),DIE="^IBA(355.34,"
- S DR=".02///"_($P(IBZ,"^",2)+1)_";.03///"_($P(IBZ,"^",3)+IBX) D ^DIE
- L -^IBA(355.34,DA)
- Q
- ;
- VALID(IBARY) ; Check for invalid entries in the incoming data
- ;Screen for Active Policy
- ;Screen for EXPIRATION DATE - Don't file expired policies
- N DATA,EXCLUDE,IBEFFDT,IBEXPDT,IBTOP,LN,TAG,VALID
- S VALID=1
- ; Check for expired policy
- S IBEXPDT=$G(IBARY(60.03))
- I IBEXPDT'="",($$FMDIFF^XLFDT(DT,IBEXPDT,1)>0) S VALID=0 G VALIDQ
- I IBEXPDT="" D I 'VALID G VALIDQ
- . ;Use LAST VERIFIED
- . I $G(IBARY(.1)) D Q
- .. I $$FMDIFF^XLFDT(DT,IBARY(.1),1)>730 S VALID=0 ;POLICY GREATER THAN 2 YEARS OLD.
- . ;Use Date Entered
- . I $G(IBARY(.01)),$$FMDIFF^XLFDT(DT,$G(IBARY(.01)),1)>730 S VALID=0 ;POLICY GREATER THAN 2 YEARS OLD.
- ;
- ;Screen EFFECTIVE DATE - Cannot be blank or future
- S IBEFFDT=$G(IBARY(60.02))
- I IBEFFDT="" S VALID=0 G VALIDQ ;BLANK EFFECTIVE DATE IS INVALID
- I IBEFFDT'="",($$FMDIFF^XLFDT(DT,IBEFFDT,1)<0) S VALID=0 G VALIDQ ;FUTURE EFFECTIVE DATE IS INVALID
- ;
- ;Screen Type of Plan
- S EXCLUDE="^"
- F LN=2:1 S TAG="EXCTOP+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" S EXCLUDE=EXCLUDE_$$FIND1^DIC(355.1,"","X",DATA)_"^"
- S IBTOP=$G(IBARY(40.09))
- I IBTOP'="",$F(EXCLUDE,(U_IBTOP_U)) S VALID=0 G VALIDQ
- ;
- ; Re-Initialize variables for filing.
- S IBARY(.01)=DT ;Set DATE ENTERED = today's date
- S IBARY(.02)="" ;Set ENTERED BY = NULL
- S IBARY(.1)="" ;Set DATE VERIFIED = NULL
- S IBARY(.11)="" ;Set VERIFIED BY = NULL
- ;
- VALIDQ ;
- I 'VALID K IBARY
- Q VALID
- ;
- DUP(IBARY) ; Check for duplicate in the incoming data
- N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
- S IBINSNM=$G(IBARY(20.01)) I IBINSNM']"" S IBINSNM=" "
- S IBGRP=$G(IBARY(40.03)) I IBGRP']"" S IBGRP=" "
- S IBSUBID=$G(IBARY(60.04)) I IBSUBID']"" S IBSUBID=" "
- S IBNAME=$P($G(IBARY(60.07))," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
- S IBDOB=$G(IBARY(60.08)) I 'IBDOB S IBDOB=" "
- Q $D(^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB))
- ;
- EXCTOP ;Plan Types to Exclude
- ;
- ;;ACCIDENT AND HEALTH INSURANCE
- ;;AUTOMOBILE
- ;;AVIATION TRIP INSURANCE
- ;;CATASTROPHIC INSURANCE
- ;;COINSURANCE
- ;;DUAL COVERAGE
- ;;HOSPITAL-MEDICAL INSURANCE
- ;;INCOME PROTECTION (INDEMNITY)
- ;;KEY-MAN HEALTH INSURANCE
- ;;MAJOR MEDICAL EXPENSE INSURANCE
- ;;MEDI-CAL
- ;;MEDICAID
- ;;MEDICARE/MEDICAID (MEDI-CAL)
- ;;NO-FAULT INSURANCE
- ;;QUALIFIED IMPAIRMENT INSURANCE
- ;;SPECIAL CLASS INSURANCE
- ;;SPECIAL RISK INSURANCE
- ;;SPECIFIED DISEASE INSURANCE
- ;;TORT FEASOR
- ;;WORKERS' COMPENSATION INSURANCE
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRDV 14569 printed Jan 18, 2025@03:17:23 Page 2
- IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;27-MAR-03
- +1 ;;2.0;INTEGRATED BILLING;**214,231,361,371,452,593,631,664,763**;21-MAR-94;Build 29
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; This routine is used to exchange insurance information between
- +5 ; facilities.
- OPT ; Menu option entry point. This is used to select a patient to request
- +1 ; information about from the remote treating facilities.
- +2 ;IB*2.0*664/TAZ - Add CTR to New List
- +3 NEW CTR,DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBFASTXT,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1
- +4 ;
- +5 ; prompt for patient
- AGAIN SET DIC="^DPT("
- SET DIC(0)="AEMNQ"
- DO ^DIC
- if Y<1
- QUIT
- SET DFN=+Y
- +1 ;
- BACKGND ; background/tasked entry point
- +1 ; IBTYPE is being used as a flag to indicate this is running in background
- +2 ;
- +3 ;IB*763/TAZ - Check Insurance Import Enabled flag and quit if not enabled.
- +4 ; for background jobs only
- +5 IF $DATA(IBTYPE)
- IF '$$GET1^DIQ(350.9,"1,",54.01,"I")
- QUIT
- +6 ;
- +7 ; look up treating facilities
- +8 KILL IBT
- SET IBT=$$TFL^IBARXMU(DFN,.IBT)
- +9 IF IBT<1
- IF '$DATA(IBTYPE)
- WRITE !!,"This patient has no remote treating facilities to query."
- GOTO AGAIN
- +10 IF IBT<1
- QUIT
- +11 ;
- +12 ; display and verify we want to do this
- +13 IF '$DATA(IBTYPE)
- DO DEM^VADPT
- WRITE !!,"The patient ",VADM(1)," has the following ",IBT," remote facilitie(s)",!
- SET IBX=0
- FOR
- SET IBX=$ORDER(IBT(IBX))
- if IBX<1
- QUIT
- WRITE !?10,$PIECE(IBT(IBX),"^",2)
- +14 IF '$DATA(IBTYPE)
- WRITE !!,"Do you want to perform this Remote Query"
- SET %=1
- DO YN^DICN
- if %'=1
- GOTO AGAIN
- +15 ;
- +16 ; get ICN
- +17 SET IBICN=$$ICN^IBARXMU(DFN)
- IF 'IBICN
- IF '$DATA(IBTYPE)
- WRITE !!,"No ICN for this patient"
- GOTO AGAIN
- +18 IF 'IBICN
- QUIT
- +19 ;
- +20 ; sent off the remote queries and get back handles
- +21 SET IBX=0
- FOR
- SET IBX=$ORDER(IBT(IBX))
- if IBX<1
- QUIT
- Begin DoDot:1
- +22 DO SEND(.IBH,IBX,IBICN,$SELECT($DATA(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY"))
- +23 XECUTE $SELECT(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)")
- End DoDot:1
- +24 ;
- +25 ; no handles returned
- +26 IF $DATA(IBT)<9
- IF '$DATA(IBTYPE)
- WRITE !!,"Unable to perform any remote queries.",!
- GOTO AGAIN
- +27 IF $DATA(IBT)<9
- QUIT
- +28 ;
- +29 ;Create Duplicate Check Index
- +30 ;IB*2.0*664/TAZ - Only build index for Background calls
- +31 IF $DATA(IBTYPE)
- DO INDEX(DFN)
- +32 ;
- +33 ; go through every IBT()
- +34 SET IBP="|"
- SET IBX=0
- FOR
- SET IBX=$ORDER(IBT(IBX))
- if IBX<1!($DATA(IBT)<9)
- QUIT
- Begin DoDot:1
- +35 ;
- +36 ; do I have a return data.
- +37 FOR IBWAIT=1:1:60
- if '$DATA(IBTYPE)
- WRITE "."
- HANG 1
- DO CHECK(.IBR,$PIECE(IBT(IBX),"^",5))
- IF $GET(IBR(0))["Done"
- QUIT
- +38 IF $GET(IBR(0))'["Done"
- if '$DATA(IBTYPE)
- WRITE !!,"Unable to communicate with ",$PIECE(IBT(IBX),U,2)
- QUIT
- +39 KILL IBR
- +40 DO RETURN(.IBR,$PIECE(IBT(IBX),"^",5))
- +41 ;
- +42 ; no data returned or error message
- +43 SET IBRZ=$SELECT(-1=+$GET(IBR):IBR,$GET(IBR(0))="":$GET(IBR(1)),1:$GET(IBR(0)))
- +44 ;
- +45 ; no info to proceed
- +46 IF IBRZ<1
- if '$DATA(IBTYPE)
- WRITE !,"Response from ",$PIECE(IBT(IBX),U,2),!,$PIECE(IBRZ,"^",2)
- KILL IBT(IBX)
- if IBRZ="-1^No insurance on file"
- DO FILE(0)
- QUIT
- +47 ;
- +48 ; received insurance info, need to file and display message
- +49 if '$DATA(IBTYPE)
- WRITE !,"Received ",$GET(IBR(0))," insurance companies from ",$PIECE(IBT(IBX),U,2)
- DO FILE(+IBR(0))
- +50 ;
- +51 SET IBY=0
- FOR
- SET IBY=$ORDER(IBR(IBY))
- if IBY<1
- QUIT
- Begin DoDot:2
- +52 FOR IBL=5:1
- SET IBT=$PIECE($TEXT(MAP+IBL),";",3)
- if IBT=""
- QUIT
- Begin DoDot:3
- +53 ;
- +54 ; am I on the right MAP line
- +55 ;IB*2.0*631/TAZ - Insurance data comes in multiples of 7
- +56 IF $PIECE(IBT,IBP,3)=$SELECT(IBY#7:IBY#7,1:7)
- SET IBZ=$PIECE(IBR(IBY),"^",$PIECE(IBT,IBP,4))
- IF $LENGTH(IBZ)
- Begin DoDot:4
- +57 ;
- +58 ; execute code to change external to internal
- +59 if $LENGTH($PIECE(IBT,IBP,7))
- XECUTE $PIECE(IBT,IBP,7)
- +60 ;
- +61 ; put the info in the array for the buffer file
- +62 if $DATA(IBZ)
- SET IBB($PIECE(IBT,IBP,5))=IBZ
- End DoDot:4
- End DoDot:3
- +63 ;
- +64 ; file in the buffer file & where else needed
- +65 ;IB*2.0*631/TAZ - File on the 7th multiple line (i.e. 7,14,21...)
- +66 IF IBY#7=0
- Begin DoDot:3
- +67 IF $LENGTH($GET(IBB(20.01)))
- Begin DoDot:4
- +68 NEW IBOK
- SET IBOK=1
- +69 SET IBB(.14)=$$IEN^XUAF4(+IBT(IBX))
- +70 SET IBB(.03)=$ORDER(^IBE(355.12,"C","INSURANCE IMPORT",""))
- +71 DO VCHECK(.IBB)
- IF 'IBOK
- QUIT
- +72 ;IB*2.0*664/TAZ - Set up ^TMP Array for input to ListMan screen if interactive
- +73 IF '$DATA(IBTYPE)
- Begin DoDot:5
- +74 SET CTR=$ORDER(^TMP($JOB,"IBCNRDV",""),-1)+1
- +75 MERGE ^TMP($JOB,"IBCNRDV",CTR)=IBB
- End DoDot:5
- QUIT
- +76 SET IBB=$$ADDSTF^IBCNBES($GET(IBB(.03),1),DFN,.IBB)
- +77 ;IB*2.0*664/TAZ - Moved the following line into this dotted Do struction since it only executed if $L($G(IBB(20.01)))
- +78 IF '$DATA(IB1)
- IF $DATA(IBTYPE)
- if IBTYPE="TRKR"
- DO SCH^IBTUTL2(DFN,$GET(IBSAVEI),$GET(IBSAVEJ))
- if IBTYPE="ADM"
- DO ADM^IBTUTL($GET(IBSAVE1),$GET(IBSAVE2),$GET(IBSAVE3),$GET(IBSAVE4))
- SET IB1=1
- End DoDot:4
- +79 KILL IBB
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +80 ;
- +81 ;IB*2.0*664/TAZ - Branch to ListMan screen if interactive
- +82 IF '$DATA(IBTYPE)
- IF $DATA(^TMP($JOB,"IBCNRDV"))
- HANG 3
- DO EN^IBCNRDV1
- +83 ;
- +84 ; flag so I don't do this patient again within 90 days
- +85 SET ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))=""
- +86 ;
- +87 ; Clean up ^TMP global
- +88 KILL ^TMP($JOB,"IBCNRDV")
- +89 ;
- +90 QUIT
- +91 ;
- VCHECK(IBB) ; Check to make sure the record is not duplicate and passes validity check.
- +1 ;
- +2 ;Check for duplicates
- +3 ;IB*2.0*664/TAZ - Only check for duplicates when processing in background
- +4 IF $DATA(IBTYPE)
- IF $$DUP(.IBB)
- SET IBOK=0
- GOTO VCHECKX
- +5 ; Validate entries to insure we are only getting the data we want.
- +6 IF '$$VALID(.IBB)
- SET IBOK=0
- GOTO VCHECKX
- +7 ;IB*2.0*664/TAZ - Only add to INDEX for background processing
- +8 IF '$DATA(IBTYPE)
- GOTO VCHECKX
- +9 ;Add to index
- +10 NEW IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
- +11 SET IBINSNM=$GET(IBB(20.01))
- IF IBINSNM']""
- SET IBINSNM=" "
- +12 SET IBGRP=$GET(IBB(40.03))
- IF IBGRP']""
- SET IBGRP=" "
- +13 SET IBSUBID=$GET(IBB(60.04))
- IF IBSUBID']""
- SET IBSUBID=" "
- +14 ;Only match on LAST,FIRST
- SET IBNAME=$PIECE($GET(IBB(60.07))," ")
- IF IBNAME']""
- SET IBNAME=" "
- +15 SET IBDOB=$GET(IBB(60.08))
- IF 'IBDOB
- SET IBDOB=" "
- +16 SET ^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
- +17 ;
- VCHECKX ;
- +1 QUIT
- +2 ;
- INDEX(DFN) ;
- +1 KILL ^TMP("IBCNRDV",$JOB)
- +2 NEW IBBUFDA,IBIEN
- +3 ; From Buffer
- +4 SET IBBUFDA=0
- +5 FOR
- SET IBBUFDA=$ORDER(^IBA(355.33,"C",DFN,IBBUFDA))
- if 'IBBUFDA
- QUIT
- Begin DoDot:1
- +6 NEW IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
- +7 SET IBINSNM=$$GET1^DIQ(355.33,IBBUFDA_",","INSURANCE COMPANY NAME")
- IF IBINSNM']""
- SET IBINSNM=" "
- +8 SET IBGRP=$$GET1^DIQ(355.33,IBBUFDA_",","GROUP NUMBER")
- IF IBGRP']""
- SET IBGRP=" "
- +9 SET IBSUBID=$$GET1^DIQ(355.33,IBBUFDA_",","SUBSCRIBER ID")
- IF IBSUBID']""
- SET IBSUBID=" "
- +10 ;Only match on LAST,FIRST
- SET IBNAME=$PIECE($$GET1^DIQ(355.33,IBBUFDA_",","NAME OF INSURED")," ")
- IF IBNAME']""
- SET IBNAME=" "
- +11 SET IBDOB=$$GET1^DIQ(355.33,IBBUFDA_",","INSURED'S DOB","I")
- IF 'IBDOB
- SET IBDOB=" "
- +12 SET ^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
- End DoDot:1
- +13 ; From active Insurance
- +14 KILL IBINS
- +15 ; Get all active insurance
- DO ALL^IBCNS1(DFN,"IBINS",2)
- +16 IF $GET(IBINS(0))
- SET IBIEN=0
- FOR
- SET IBIEN=$ORDER(IBINS(IBIEN))
- if 'IBIEN
- QUIT
- Begin DoDot:1
- +17 NEW IBDOB,IBGRP,IBINSIEN,IBINSNM,IBNAME,IBSUBID
- +18 SET IBINSIEN=+$PIECE($GET(IBINS(IBIEN,0)),U,1)
- +19 SET IBINSNM=$$GET1^DIQ(36,IBINSIEN_",","NAME")
- IF IBINSNM']""
- SET IBINSNM=" "
- +20 SET IBGRP=$PIECE($GET(IBINS(IBIEN,355.3)),U,4)
- IF IBGRP']""
- SET IBGRP=" "
- +21 SET IBSUBID=$PIECE($GET(IBINS(IBIEN,7)),U,2)
- IF IBSUBID']""
- SET IBSUBID=" "
- +22 SET IBNAME=$PIECE($PIECE($GET(IBINS(IBIEN,7)),U)," ")
- IF IBNAME']""
- SET IBNAME=" "
- +23 SET IBDOB=$PIECE($GET(IBINS(IBIEN,3)),U)
- IF 'IBDOB
- SET IBDOB=" "
- +24 SET ^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
- End DoDot:1
- +25 KILL IBINS
- +26 ;
- +27 QUIT
- +28 ;
- RPC(IBD,IBICN) ; RPC entry for looking up insurance info
- +1 NEW DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ
- +2 SET DFN=$$DFN^IBARXMU(IBICN)
- IF 'DFN
- SET IBD(0)="-1^ICN Not found"
- QUIT
- +3 DO ALL^IBCNS1(DFN,"IBY",3)
- +4 IF '$DATA(IBY)
- SET IBD(0)="-1^No insurance on file"
- QUIT
- +5 ; set up return format
- +6 ; IBD(0) = # of insurance companies
- +7 SET IBD(0)=$GET(IBY(0))
- +8 ;
- +9 ; where n starts at 1 and increments to 7 for each insurance company
- +10 ; IBD(n) = 355.33, zero node format
- +11 ; IBD(n+1) = 355.33, 20 node format
- +12 ; IBD(n+2) = 355.33, 21 node format
- +13 ; IBD(n+3) = 355.33, 40 node format
- +14 ; IBD(n+4) = 355.33, 60 node format
- +15 ; IBD(n+5) = 355.33, 61 node format
- +16 ; IBD(n+6) = 355.33, 62 node format
- +17 ;
- +18 SET IBP="|"
- +19 SET IBI=0
- FOR
- SET IBI=$ORDER(IBY(IBI))
- if IBI<1
- QUIT
- FOR IBL=5:1
- SET IBT=$PIECE($TEXT(MAP+IBL),";",3)
- if IBT=""
- QUIT
- Begin DoDot:1
- +20 ; set the existing data
- SET IBZ=$PIECE($GET(IBY(IBI,+IBT)),"^",$PIECE(IBT,IBP,2))
- +21 ; output transform
- IF $LENGTH($PIECE(IBT,IBP,6))
- XECUTE $PIECE(IBT,IBP,6)
- +22 ; set data IBD
- SET $PIECE(IBD(IBI-1*7+$PIECE(IBT,IBP,3)),"^",$PIECE(IBT,IBP,4))=IBZ
- End DoDot:1
- +23 QUIT
- +24 ;
- MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file
- +1 ; format is: node number | piece | extract node | extract piece
- +2 ; | 355.33 field number | format out code (if any)
- +3 ; | format in code (if any)
- +4 ; the extract nodes will be sequential to match buffer file DD
- +5 ;;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
- +6 ;;0|2|5|4|60.04;subscriber id
- +7 ;;0|4|5|3|60.03;experation date
- +8 ;;0|6|5|5|60.05;who's insurance
- +9 ;;0|8|5|2|60.02;effective date
- +10 ;;0|16|5|6|60.06;pt relationship to insured
- +11 ;;0|17|5|7|60.07;name of insured
- +12 ;;0|20|5|12|60.12;coordination of benefits
- +13 ;;1|1|1|1|.01||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date entered ;IB*593/TAZ
- +14 ;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified
- +15 ;;1|9|1|3|.03||S IBZ=$O(^IBE(355.12,"C","INSURANCE IMPORT",""));source of information ; Patch #593 Set to INSPT
- +16 ;;2|1|6|5|61.05;send bill to employer
- +17 ;;2|2|6|6|61.06;employer claims street address (line 1)
- +18 ;;2|3|6|7|61.07;employer claims street address line 2
- +19 ;;2|4|6|8|61.08;employer claims street address line 3
- +20 ;;2|5|6|9|61.09;employer claims city
- +21 ;;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
- +22 ;;2|7|6|11|61.11;employer claims zip code
- +23 ;;2|8|6|12|61.12;employer claims phone
- +24 ;;2|10|6|1|61.01;esghp
- +25 ;;2|11|6|3|61.03;employment status
- +26 ;;2|12|6|4|61.04;retirement date
- +27 ;;3|1|5|8|60.08;insured's dob
- +28 ;;3|5|5|9|60.09;insured's ssn
- +29 ;;3|12|5|13|60.13;insured's sex
- +30 ;;4|1|5|10|60.1;primary care provider
- +31 ;;4|2|5|11|60.11;primary provider phone
- +32 ;;4|5|5|15|60.15;pharmacy relationship code
- +33 ;;4|6|5|16|60.16;pharmacy person code
- +34 ;;5|1|7|1|62.01;patient id
- +35 ;;355.3|2|4|1|40.01;is this a group policy
- +36 ;;355.3|3|4|2|40.02;group name
- +37 ;;355.3|4|4|3|40.03;group number
- +38 ;;355.3|5|4|4|40.04;(is) utilization required
- +39 ;;355.3|6|4|5|40.05;(is) pre-certification required
- +40 ;;355.3|7|4|7|40.07;exclude pre-existing condition
- +41 ;;355.3|8|4|8|40.08;benefits assignable
- +42 ;;355.3|9|4|9|40.09;type of plan
- +43 ;;355.3|12|4|6|40.06;ambulatory care certification
- +44 ;;36|2|2|5|20.05;reimburse
- +45 ;;36.11|1|3|1|21.01;street address line 1
- +46 ;;36.11|2|3|2|21.02;street address line 2
- +47 ;;36.11|3|3|3|21.03;street address line 3
- +48 ;;36.11|4|3|4|21.04;city
- +49 ;;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
- +50 ;;36.11|6|3|6|21.06;zip code
- +51 ;;36.13|1|2|2|20.02;phone number
- +52 ;;36.13|2|2|3|20.03;billing phone number
- +53 ;;36.13|3|2|4|20.04;precertification phone number
- +54 ;;
- +55 ;
- SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries
- +1 DO EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN)
- +2 QUIT
- +3 ;
- CHECK(IBR,IBH) ; called to check the return status of an RPC
- +1 DO RPCCHK^XWB2HL7(.IBR,IBH)
- +2 QUIT
- +3 ;
- RETURN(IBR,IBH) ; called to get the return data and clear the broker
- +1 NEW IBZ
- +2 DO RTNDATA^XWBDRPC(.IBR,IBH)
- DO CLEAR^XWBDRPC(.IBZ,IBH)
- +3 QUIT
- +4 ;
- TASK ; queue off task job
- +1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
- +2 SET ZTRTN="BACKGND^IBCNRDV"
- SET ZTDESC="Query Remote Facilities for Insurance"
- SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT)
- SET (ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))=""
- DO ^%ZTLOAD
- +3 QUIT
- +4 ;
- TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry
- +1 NEW IBTYPE,IBT
- +2 ; have already done recently
- if $DATA(^IBT(356,"ARDV",DFN))
- QUIT
- +3 ; no remote facilities
- if '$$TFL^IBARXMU(DFN,.IBT)
- QUIT
- +4 SET IBTYPE="TRKR"
- Begin DoDot:1
- +5 IF DUZ=.5
- NEW DUZ
- SET DUZ=+$GET(IBDUZ)
- SET DUZ(2)=+$$SITE^VASITE
- +6 DO TASK
- End DoDot:1
- +7 QUIT
- +8 ;
- ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry
- +1 NEW IBTYPE
- SET IBTYPE="ADM"
- DO TASK
- +2 QUIT
- +3 ;
- FILE(IBX) ; updates data into the log file
- +1 ;IBX = number of insurance co's found
- +2 NEW DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR
- +3 SET IBM=$EXTRACT($$DT^XLFDT,1,5)_"00"
- SET DA=+$ORDER(^IBA(355.34,"B",IBM,0))
- +4 IF 'DA
- KILL DA
- LOCK +^IBA(355.34,"B",IBM):10
- SET X=IBM
- SET DIC="^IBA(355.34,"
- SET DIC(0)="F"
- DO FILE^DICN
- SET DA=+Y
- LOCK -^IBA(355.34,"B",IBM)
- +5 LOCK +^IBA(355.34,DA):10
- +6 SET IBZ=^IBA(355.34,DA,0)
- SET DIE="^IBA(355.34,"
- +7 SET DR=".02///"_($PIECE(IBZ,"^",2)+1)_";.03///"_($PIECE(IBZ,"^",3)+IBX)
- DO ^DIE
- +8 LOCK -^IBA(355.34,DA)
- +9 QUIT
- +10 ;
- VALID(IBARY) ; Check for invalid entries in the incoming data
- +1 ;Screen for Active Policy
- +2 ;Screen for EXPIRATION DATE - Don't file expired policies
- +3 NEW DATA,EXCLUDE,IBEFFDT,IBEXPDT,IBTOP,LN,TAG,VALID
- +4 SET VALID=1
- +5 ; Check for expired policy
- +6 SET IBEXPDT=$GET(IBARY(60.03))
- +7 IF IBEXPDT'=""
- IF ($$FMDIFF^XLFDT(DT,IBEXPDT,1)>0)
- SET VALID=0
- GOTO VALIDQ
- +8 IF IBEXPDT=""
- Begin DoDot:1
- +9 ;Use LAST VERIFIED
- +10 IF $GET(IBARY(.1))
- Begin DoDot:2
- +11 ;POLICY GREATER THAN 2 YEARS OLD.
- IF $$FMDIFF^XLFDT(DT,IBARY(.1),1)>730
- SET VALID=0
- End DoDot:2
- QUIT
- +12 ;Use Date Entered
- +13 ;POLICY GREATER THAN 2 YEARS OLD.
- IF $GET(IBARY(.01))
- IF $$FMDIFF^XLFDT(DT,$GET(IBARY(.01)),1)>730
- SET VALID=0
- End DoDot:1
- IF 'VALID
- GOTO VALIDQ
- +14 ;
- +15 ;Screen EFFECTIVE DATE - Cannot be blank or future
- +16 SET IBEFFDT=$GET(IBARY(60.02))
- +17 ;BLANK EFFECTIVE DATE IS INVALID
- IF IBEFFDT=""
- SET VALID=0
- GOTO VALIDQ
- +18 ;FUTURE EFFECTIVE DATE IS INVALID
- IF IBEFFDT'=""
- IF ($$FMDIFF^XLFDT(DT,IBEFFDT,1)<0)
- SET VALID=0
- GOTO VALIDQ
- +19 ;
- +20 ;Screen Type of Plan
- +21 SET EXCLUDE="^"
- +22 FOR LN=2:1
- SET TAG="EXCTOP+"_LN
- SET DATA=$PIECE($TEXT(@TAG),";;",2)
- if DATA=""
- QUIT
- SET EXCLUDE=EXCLUDE_$$FIND1^DIC(355.1,"","X",DATA)_"^"
- +23 SET IBTOP=$GET(IBARY(40.09))
- +24 IF IBTOP'=""
- IF $FIND(EXCLUDE,(U_IBTOP_U))
- SET VALID=0
- GOTO VALIDQ
- +25 ;
- +26 ; Re-Initialize variables for filing.
- +27 ;Set DATE ENTERED = today's date
- SET IBARY(.01)=DT
- +28 ;Set ENTERED BY = NULL
- SET IBARY(.02)=""
- +29 ;Set DATE VERIFIED = NULL
- SET IBARY(.1)=""
- +30 ;Set VERIFIED BY = NULL
- SET IBARY(.11)=""
- +31 ;
- VALIDQ ;
- +1 IF 'VALID
- KILL IBARY
- +2 QUIT VALID
- +3 ;
- DUP(IBARY) ; Check for duplicate in the incoming data
- +1 NEW IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
- +2 SET IBINSNM=$GET(IBARY(20.01))
- IF IBINSNM']""
- SET IBINSNM=" "
- +3 SET IBGRP=$GET(IBARY(40.03))
- IF IBGRP']""
- SET IBGRP=" "
- +4 SET IBSUBID=$GET(IBARY(60.04))
- IF IBSUBID']""
- SET IBSUBID=" "
- +5 ;Only match on LAST,FIRST
- SET IBNAME=$PIECE($GET(IBARY(60.07))," ")
- IF IBNAME']""
- SET IBNAME=" "
- +6 SET IBDOB=$GET(IBARY(60.08))
- IF 'IBDOB
- SET IBDOB=" "
- +7 QUIT $DATA(^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB))
- +8 ;
- EXCTOP ;Plan Types to Exclude
- +1 ;
- +2 ;;ACCIDENT AND HEALTH INSURANCE
- +3 ;;AUTOMOBILE
- +4 ;;AVIATION TRIP INSURANCE
- +5 ;;CATASTROPHIC INSURANCE
- +6 ;;COINSURANCE
- +7 ;;DUAL COVERAGE
- +8 ;;HOSPITAL-MEDICAL INSURANCE
- +9 ;;INCOME PROTECTION (INDEMNITY)
- +10 ;;KEY-MAN HEALTH INSURANCE
- +11 ;;MAJOR MEDICAL EXPENSE INSURANCE
- +12 ;;MEDI-CAL
- +13 ;;MEDICAID
- +14 ;;MEDICARE/MEDICAID (MEDI-CAL)
- +15 ;;NO-FAULT INSURANCE
- +16 ;;QUALIFIED IMPAIRMENT INSURANCE
- +17 ;;SPECIAL CLASS INSURANCE
- +18 ;;SPECIAL RISK INSURANCE
- +19 ;;SPECIFIED DISEASE INSURANCE
- +20 ;;TORT FEASOR
- +21 ;;WORKERS' COMPENSATION INSURANCE
- +22 ;