- 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/IBCEP4.m
r613 r623 1 IBCEP4 2 ;;2.0;INTEGRATED BILLING;**137,320,348,349,377**;21-MAR-94;Build 23 3 4 5 EN 6 7 8 9 10 EN1(IBINS) 11 12 S VALMBCK="R" 13 D ENX 14 Q 15 ; 16 ENX ; Common call to list template for dual entry points 17 N IBSLEV,DIR,Y 18 K IBFASTXT 19 D FULL^VALM1 20 S DIR(0)="SA^1:Performing Provider Care Units;2:Billing Provider Care Units" 21 S DIR("A")="Enter Type of Care Unit: ",DIR("B")=$P($P(DIR(0),":",2),";",1) 22 W ! D ^DIR K DIR W ! 23 I Y'>0 Q 24 S IBSLEV=+Y 25 I IBSLEV=2 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") Q 26 D EN^VALM("IBCE PRVCARE UNIT MAINT") 27 Q 28 ; 29 HDR ; -- header 30 K VALMHDR 31 S VALMHDR(1)=" " 32 S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL") 33 Q 34 ; 35 INIT ; -- init variables, list array 36 N Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X 37 I $G(IBINS) S Y=IBINS ; For entrypoint from provider number maintenance 38 ; 39 I '$G(IBINS) D 40 . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units" 41 . D ^DIR K DIR 42 . I $D(DTOUT)!$D(DUOUT) S Y=-2Q43 . I Y>0 S IBINS=+Y Q 44 ; 45 I Y'=-2D46 . D BLD47 E D 48 . S VALMQUIT=1 49 Q 50 ; 51 BLD ; Bld display - IBINS must = ien of file 36 52 K ^TMP("IBPRV_CU",$J) 53 ; 54 I $G(IBSLEV)=2 Q 55 ; 56 S (IBENT,IBLCT)=0,IBNM="" 57 F S IBNM=$O(^IBA(355.95,"C",IBINS,IBNM)) Q:IBNM="" S Z=0 F S Z=$O(^IBA(355.95,"C",IBINS,IBNM,Z)) Q:'Z S IB=$G(^IBA(355.95,Z,0)) I IB'="",$P(IB,U,4)="" D 58 . S IBLCT=IBLCT+1,IBENT=IBENT+1 59 . I '$D(^IBA(355.96,"AUNIQ",IBINS,Z)) D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20)_" (NO COMBINATIONS FOUND)",IBENT) Q 60 . D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20),IBENT) 61 . S ^TMP("IBPRV_CU",$J,"ZIDX",IBENT)=Z 62 . S Z0=0 F S Z0=$O(^IBA(355.96,"AE",Z,Z0)) Q:'Z0 S Z1=0 F S Z1=$O(^IBA(355.96,"AE",Z,Z0,Z1)) Q:'Z1 S IB0=$G(^IBA(355.96,Z1,0)) I IB0'="" D 63 .. S IBLCT=IBLCT+1 64 .. S IBQ=$J("",28)_"o "_$E($$EXPAND^IBTRE(355.96,.06,+$P(IB0,U,6))_$J("",20),1,20)65 .. S IBQ=IBQ_" "_$E($P("Both form types^UB-04 Only^CMS-1500 Only",U,$P(IB0,U,4)+1)_$J("",15),1,15)_" "_$E($P("Inpt/Outpt^Inpt Only^Outpt Only^RX Only",U,+$P(IB0,U,5)+1)_$J("",10),1,10)66 .. D SET^VALM10(IBLCT,IBQ,IBENT) 67 ; 68 I 'IBLCT D SET^VALM10(1,"No CARE UNITs Found"_$S('$G(IBINS):"",1:" for Insurance Co")) S IBLCT=169 S VALMCNT=IBLCT,VALMBG=1 70 Q 71 ; 72 HELP ; -- help 73 ; 74 I $G(IBSLEV)=2 Q 75 ; 76 S X="?" D DISP^XQORM1 W !! 77 Q 78 ; 79 EXIT ; -- exit 80 81 82 83 84 EXPND 85 86 87 SEL(IBDA,MANY) 88 89 90 91 92 93 94 95 96 97 DISP(IBVAR,IBINS,IBPTYP,IBFT,IBCT,START,END) 98 99 100 101 102 103 104 105 106 107 108 109 CAREUOK(IBIFN,IBCU,IBTYPE,IBSEQ) 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 CAREOKQ 128 1 IBCEP4 ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00 2 ;;2.0;INTEGRATED BILLING;**137,320,348,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EN ; -- main entry point 6 N IBINS,IBALL,IB95 7 D ENX 8 Q 9 ; 10 EN1(IBINS) ; -- Entry point from provider number maintenence 11 N IBPRV,IBALL,IB95 12 D ENX 13 Q 14 ; 15 ENX ; Common call to list template for dual entry points 16 N IBSLEV,DIR,Y 17 K IBFASTXT 18 D FULL^VALM1 19 S DIR(0)="SA^1:Care Units for Performing Provider IDs;2:Care Units for Billing Provider Secondary IDs" 20 S DIR("A")="Enter Type of Care Unit: ",DIR("B")=$P($P(DIR(0),":",2),";") 21 W ! D ^DIR K DIR W ! 22 I Y'>0 Q 23 S IBSLEV=+Y 24 I IBSLEV=2 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") Q 25 D EN^VALM("IBCE PRVCARE UNIT MAINT") 26 Q 27 ; 28 HDR ; -- header 29 K VALMHDR 30 S VALMHDR(1)=" " 31 S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL") 32 Q 33 ; 34 INIT ; -- init variables, list array 35 N Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X 36 I $G(IBINS) S Y=IBINS ; For entrypoint from provider number maintenance 37 ; 38 I '$G(IBINS) D 39 . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units" 40 . D ^DIR K DIR 41 . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q 42 . I Y>0 S IBINS=+Y Q 43 ; 44 I Y'=-2 D 45 . D BLD 46 E D 47 . S VALMQUIT=1 48 Q 49 ; 50 BLD ; Bld display - IBINS must = ien of file 36 51 K ^TMP("IBPRV_CU",$J) 52 ; 53 I $G(IBSLEV)=2 Q 54 ; 55 S (IBENT,IBLCT)=0,IBNM="" 56 F S IBNM=$O(^IBA(355.95,"C",IBINS,IBNM)) Q:IBNM="" S Z=0 F S Z=$O(^IBA(355.95,"C",IBINS,IBNM,Z)) Q:'Z S IB=$G(^IBA(355.95,Z,0)) I IB'="",$P(IB,U,4)="" D 57 . S IBLCT=IBLCT+1,IBENT=IBENT+1 58 . I '$D(^IBA(355.96,"AUNIQ",IBINS,Z)) D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20)_" (NO COMBINATIONS FOUND)",IBENT) Q 59 . D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20),IBENT) 60 . S ^TMP("IBPRV_CU",$J,"ZIDX",IBENT)=Z 61 . S Z0=0 F S Z0=$O(^IBA(355.96,"AE",Z,Z0)) Q:'Z0 S Z1=0 F S Z1=$O(^IBA(355.96,"AE",Z,Z0,Z1)) Q:'Z1 S IB0=$G(^IBA(355.96,Z1,0)) I IB0'="" D 62 .. S IBLCT=IBLCT+1 63 .. S IBQ=$J("",28)_"o "_$E($$EXPAND^IBTRE(355.96,.06,+$P(IB0,U,6))_$J("",20),1,20) 64 .. S IBQ=IBQ_" "_$E($P("Both form types^UB-04 Only^CMS-1500 Only",U,$P(IB0,U,4)+1)_$J("",15),1,15)_" "_$E($P("Inpt/Outpt^Inpt Only^Outpt Only^RX Only",U,+$P(IB0,U,5)+1)_$J("",10),1,10) 65 .. D SET^VALM10(IBLCT,IBQ,IBENT) 66 ; 67 I 'IBLCT D SET^VALM10(1,"No CARE UNITs Found"_$S('$G(IBINS):"",1:" for Insurance Co")) 68 S VALMCNT=IBLCT,VALMBG=1 69 Q 70 ; 71 HELP ; -- help 72 ; 73 I $G(IBSLEV)=2 Q 74 ; 75 S X="?" D DISP^XQORM1 W !! 76 Q 77 ; 78 EXIT ; -- exit 79 K IBFASTXT 80 D CLEAN^VALM10 81 K ^TMP("IBPRV_CU",$J),IBINS,IBALL 82 Q 83 ; 84 EXPND ; 85 Q 86 ; 87 SEL(IBDA,MANY) ; Select from care unit list 88 ; IBDA is passed by reference and IBDA(1) returned containing 89 ; ien's of the care unit selected (file 355.95). 90 ; If > 1 entry can be selected, MANY is set to 1 91 N Z 92 S IBDA=0 93 D EN^VALM2($G(XQORNOD(0)),$S($G(MANY):"",1:"S")) 94 S Z=0 F S Z=$O(VALMY(Z)) Q:'Z S IBDA=IBDA+1,IBDA(IBDA)=+$G(^TMP("IBPRV_CU",$J,"ZIDX",Z)) 95 Q 96 ; 97 DISP(IBVAR,IBINS,IBPTYP,IBFT,IBCT,START,END) ; Set up display array for 98 ; provider id 99 N Z 100 S START=$S($G(START):START,1:1) 101 S (Z,END)=$G(START) 102 S @IBVAR@(START)="INSURANCE: "_$S(IBINS:$P($G(^DIC(36,+IBINS,0)),U),1:"ALL INSURANCE") 103 S @IBVAR@(START+1)="PROV TYPE: "_$$EXPAND^IBTRE(355.96,.06,IBPTYP) 104 S @IBVAR@(START+2)="FORM TYPE: "_$$EXPAND^IBTRE(355.96,.04,IBFT) 105 S @IBVAR@(START+3)="CARE TYPE: "_$$EXPAND^IBTRE(355.96,.05,IBCT) 106 S END=$G(START)+3 107 Q 108 ; 109 CAREUOK(IBIFN,IBCU,IBTYPE,IBSEQ) ; Returns 1 if care unit is appropriate 110 ; for bill based on provider type, care type, bill type and insurance co 111 ; IBIFN = ien of bill (file 399) 112 ; IBCU = the ien of the care unit (file 355.96) 113 ; IBTYPE = type of ID being checked (1=performing, 2=EMC) 114 ; IBSEQ = the COB seq being checked (1-3) 115 N Z,IBOK,IBINS,IBCT,IBFT,IBPTYP,IBRX 116 S IBOK=0 117 S IBINS=+$$FINDINS^IBCEF1(IBIFN,+IBSEQ),IBFT=$S($$FT^IBCEF(IBIFN)=2:2,1:1) 118 S IBPTYP=+$S(IBTYPE=1:$$PPTYP^IBCEP0(IBINS),1:$$EMCID^IBCEP()) 119 S IBRX=$$ISRX^IBCEF1(IBIFN) 120 S IBCT=$S('IBRX:$S($$INPAT^IBCEF(IBIFN,1):1,1:2),1:3) 121 ;Check from most general to most specific 122 I $D(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ 123 I 'IBRX,$D(^IBA(355.96,"AD",IBINS,IBFT,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ 124 I $D(^IBA(355.96,"AD",IBINS,0,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ 125 I $D(^IBA(355.96,"AD",IBINS,IBFT,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ 126 ; 127 CAREOKQ Q IBOK 128 ;
Note:
See TracChangeset
for help on using the changeset viewer.
