- 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/IBCSC3.m
r613 r623 1 IBCSC3 ;ALB/MJB - MCCR SCREEN 3 (PAYER/MAILING ADDRESS) ;27 MAY 88 10:15 2 ;;2.0;INTEGRATED BILLING;**8,43,52,80,82,51,137,232,320,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRSC3 6 ; 7 EN N IB,IBX,IBINS,Y,Z 8 I $D(DGRVRCAL) D ^IBCU6 K DGRVRCAL 9 D ^IBCSCU S IBSR=3,IBSR1="",IBV1="000" I IBV S IBV1="111" 10 D H^IBCSCU 11 D:$D(^DGCR(399,IBIFN,"AIC")) 3^IBCVA0 12 D:'$D(^DGCR(399,IBIFN,"AIC")) 123^IBCVA 13 D POL^IBCNSU41(DFN) 14 F I=0,"M","M1","U","U2" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):(^(I)),1:"") 15 S IBOUTP=2,IBINDT=$S(+$G(IB("U")):+IB("U"),1:DT) 16 ; 17 S X=" Rate Type : "_$S($P(IB(0),U,7)']"":IBU,$D(^DGCR(399.3,$P(IB(0),U,7),0)):$P(^(0),U),1:IBUN) 18 S Z=1,IBW=1 X IBWW W X 19 I +$P($G(^IBE(350.9,1,1)),U,22) W $J("",(42-$L(X))),"Form Type: ",$P($G(^IBE(353,+$P(IB(0),U,19),0)),U,1) 20 W !?4,"Responsible: ",$S($P(IB(0),U,11)']"":IBU,$P(IB(0),U,11)="p":"PATIENT",$P(IB(0),U,11)="i":"INSURER",1:"OTHER") 21 W ?45,"Payer Sequence: " S IBX=$P(IB(0),U,21) W $S(IBX="P":"Primary",IBX="S":"Secondary",IBX="T":"Tertiary",IBX="A":"Patient",1:"") 22 I $P(IB(0),U,11)="i" D 23 . W !?4,"Bill Payer : " S X=$G(^DGCR(399,IBIFN,"MP")) 24 . W $S(+X:$P($G(^DIC(36,+X,0)),U,1),$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)):"MRA NEEDED FROM MEDICARE",1:IBU) 25 . W ?45,"Transmit: " S Z=0,X=$$TXMT^IBCEF4(IBIFN,.Z) 26 . W $S(X:"Yes",1:"No-"_$S(Z=1:"Forced to print local",Z=2&($$WNRBILL^IBEFUNC(IBIFN)):"MRA not active",Z=2:"EDI not active",Z=3:"Rate typ transmit off",Z=4:"Ins. co transmit off",Z=5:"Failed RULE #"_$G(Z(0)),Z=6:"Invalid NDC code type",1:"??")) 27 I $P(IB(0),U,11)']"" G MAIL 28 I $P(IB(0),U,11)="p" G MAIL 29 I $P(IB(0),U,11)="o" W !?4,"Inst. Name : ",$S($P(IB("M"),U,11)']"":IBU,$D(^DIC(4,$P(IB("M"),U,11),0)):$P(^(0),U,1),1:"UNKNOWN INSTITUTION") G MAIL 30 I $P(IB(0),U,11)="i" I $D(IBDD)>1,$D(^DGCR(399,IBIFN,"AIC")) G SHW 31 D UP G LST:$D(IBDD)>1 W !?4,"Insurance : NO REIMBURSABLE INSURANCE INFORMATION ON FILE",!?17,"[Add Insurance Information by entering '1' at the prompt below]" G MAIL 32 ; 33 LST N IBDTIN,IBICT 34 S IBDTIN=+$G(IB("U")),IBICT=0 35 W ! D HDR^IBCNS 36 S I=0 F S I=$O(IBDD("S",I)) Q:'I D Q:IBICT'<5 37 .S IBX=0 F S IBX=$O(IBDD("S",I,IBX)) Q:'IBX S IBINS=$G(IBDD(IBX,0)) I IBINS'="" S IBICT=IBICT+1 D:IBICT<5 D1^IBCNS I IBICT'<5 W !,?1,"**Patient has additional insurance - use ?INS to see the entire list" Q 38 G MAIL 39 LST1 W !?4,$S($D(^DIC(36,+IBDD(IBX,0),0)):$E($P(^(0),"^",1),1,20),1:"UNKNOWN") S X=$P(IBDD(IBX,0),"^",6) W ?26,$S(X="v":"VETERAN",X="s":"SPOUSE",1:"OTHER") S X=$P(IBDD(IBX,0),"^",16) 40 S X=$S(+X=1:"PATIENT",+X=2:"SPOUSE",+X=3:"CHILD",+X=8:"EMPLOYEE",+X=11:"ORGAN DONOR",+X=18:"PARENT",+X=15:"PLANTIFF",1:"UNKNOWN") 41 I X="UNKNOWN" S X1=$S($D(IBDD(IBX,0)):$P(IBDD(IBX,0),"^",6),1:""),X=$S(X1="v":"PATIENT",X1="s":"SPOUSE",1:X) 42 W ?37,X,?49 S Y=$P(IBDD(IBX,0),"^",8) X ^DD("DD") W Y,?64 S Y=$P(IBDD(IBX,0),"^",4) X ^DD("DD") W Y 43 Q 44 SHW I $D(IBDD) S I="" F S I=$O(IBDD(I)) Q:'I D SHW1 45 MAIL I $$BUFFER^IBCNBU1(DFN) W !!,?17,"*** Patient has Insurance Buffer entries ***" 46 ; 47 S IB("M")=$S($D(^DGCR(399,IBIFN,"M")):^("M"),1:""),IB("M1")=$S($D(^DGCR(399,IBIFN,"M1")):^("M1"),1:""),IB(0)=^DGCR(399,IBIFN,0) 48 S Z=2,IBW=1 W ! X IBWW 49 N IBRAMS S IBRAMS=4.06 50 I $$FT^IBCEF(IBIFN)=3 S IBRAMS=4.08 51 S IB("RAFLAG",1)=$S($P(IB("M"),U,1)="":0,1:$$GET1^DIQ(36,$P(IB("M"),U,1),IBRAMS,"I")) 52 S IB("RAFLAG",2)=$S($P(IB("M"),U,2)="":0,1:$$GET1^DIQ(36,$P(IB("M"),U,2),IBRAMS,"I")) 53 S IB("RAFLAG",3)=$S($P(IB("M"),U,3)="":0,1:$$GET1^DIQ(36,$P(IB("M"),U,3),IBRAMS,"I")) 54 S X=0 55 I $P(IB("M1"),U,2)="",'IB("RAFLAG",1),$P(IB("M1"),U,3)="",'IB("RAFLAG",2),$P(IB("M1"),U,4)="",'IB("RAFLAG",3) S X=1 56 W " Billing Provider Secondary IDs: " 57 I X W IBUN ; no data found, unspecified not required 58 I 'X D ; data found, display below 59 . W !?5,"Primary Payer: ",$S($P(IB("M1"),U,2)]"":$P(IB("M1"),U,2),IB("RAFLAG",1):"ATT/REND ID",1:"") 60 . W !?5,"Secondary Payer: ",$S($P(IB("M1"),U,3)]"":$P(IB("M1"),U,3),IB("RAFLAG",2):"ATT/REND ID",1:"") 61 . W ?46,"Tertiary Payer: ",$S($P(IB("M1"),U,4)]"":$P(IB("M1"),U,4),IB("RAFLAG",3):"ATT/REND ID",1:"") 62 . Q 63 ; 64 S Z=3,IBW=1 W ! X IBWW 65 W " Mailing Address : " 66 S X=+$G(^DGCR(399,IBIFN,"MP")) 67 I 'X,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S X=+$$CURR^IBCEF2(IBIFN) 68 I X,+$G(^DIC(36,X,3)) S I=$P(^(3),U,$S($$FT^IBCEF(IBIFN)=2:2,1:4)) W ?56,"Electronic ID: ",$S(I'="":I,1:"<NONE>") 69 S X="" I IB("M")]"" F I=4:1:9 Q:X]"" S X=$P(IB("M"),"^",I) 70 I X']"" W !?4,"NO MAILING ADDRESS HAS BEEN SPECIFIED!",?45,$$UP1,!?4,"Send Bill to PAYER listed above." G ENDSCR 71 S X=IB("M") W !,?4,$S($P(X,"^",4)]"":$P(X,"^",4),1:"'MAIL TO' PERSON/PLACE UNSPECIFIED"),?45,$$UP1 72 W !?4,$S($P(X,"^",5)]"":$P(X,"^",5),1:"STREET ADDRESS UNSPECIFIED") W:$P(X,"^",6)]"" ", ",$P(X,"^",6) 73 W ! W:$P(IB("M1"),"^",1)]"" ?4,$P(IB("M1"),"^",1),", " 74 W ?4,$S($P(X,"^",7)]"":$P(X,"^",7),1:"CITY UNSPECIFIED"),", ",$S($D(^DIC(5,+$P(X,"^",8),0)):$P(^(0),"^",2),1:"STATE UNSPECIFIED")," ",$S($P(X,"^",9)]"":$P(X,"^",9),1:"ZIP UNSPECIFIED") 75 ; 76 ENDSCR K IBADI,IBDD,IBOUTP,IBINDT,I,X,X1 77 G ^IBCSCP 78 ; 79 SHW1 S X=IBDD(I,0),Z=$G(^DIC(36,+X,0)) 80 W !!?4,"Ins ",I,": " W $E($S($P(Z,U,1)'="":$P(Z,U,1),1:IBU),1,16) 81 I $P(Z,U,2)="N" W ?30,"WILL NOT REIMBURSE" 82 W ?51,"Policy #: ",$E($S($P(X,"^",2)]"":$P(X,"^",2),1:IBU),1,18) 83 W !?4,"Grp #: ",$E($S($P(X,"^",3)]"":$P(X,"^",3),1:IBU),1,16) 84 W ?30,"Whose: ",$S($P(X,"^",6)="v":"VETERAN",$P(X,"^",6)="s":"SPOUSE",1:"OTHER") 85 W ?51,"Rel to Insd: ",IBIR(I) 86 W !?4,"Grp Nm: ",$E($S($P(X,"^",15)]"":$P(X,"^",15),1:IBU),1,16) 87 W ?30,"Insd Sex: ",$S($D(IBISEX(I)):IBISEX(I),1:IBU) 88 W ?51,"Insured: ",$E($P(X,"^",17),1,19) 89 Q 90 ; 91 UP K IBDD D ALL^IBCNS1(DFN,"IBDD",2,IBINDT,1) 92 I $D(IBDD("S",.5)) D ; At least 1 MCR WNR insurance policy exists 93 . ;try to put correct part (A for institution and B for facility) 94 . N Z,IBAB 95 . S IBAB=$S($$FT^IBCEF(IBIFN)=3:"A",1:"B") 96 . S Z=0 F S Z=$O(IBDD("S",.5,Z)) Q:'Z D 97 .. I $P($G(IBDD(Z,355.3)),U,14)=IBAB S IBDD("S",.1,Z,0)="" K IBDD("S",.5,Z) 98 Q 99 ; 100 UP1() ;check if patient has medicare so can print a flag for the user 101 N IBDD,IBX,IBY S IBY="" D ALL^IBCNS1(DFN,"IBDD",2,IBINDT) 102 S IBX=0 F S IBX=$O(IBDD(IBX)) Q:'IBX I $P($G(IBDD(IBX,355.3)),U,9)=33 S IBY="(Patient has Medicare)" 103 Q IBY 104 ;IBCSC3 1 IBCSC3 ;ALB/MJB - MCCR SCREEN 3 (PAYER/MAILING ADDRESS) ;27 MAY 88 10:15 2 ;;2.0;INTEGRATED BILLING;**8,43,52,80,82,51,137,232,320**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 ; 5 ;MAP TO DGCRSC3 6 ; 7 EN N IB,IBX,IBINS,Y,Z 8 I $D(DGRVRCAL) D ^IBCU6 K DGRVRCAL 9 D ^IBCSCU S IBSR=3,IBSR1="",IBV1="000" I IBV S IBV1="111" 10 D H^IBCSCU 11 D:$D(^DGCR(399,IBIFN,"AIC")) 3^IBCVA0 12 D:'$D(^DGCR(399,IBIFN,"AIC")) 123^IBCVA 13 D POL^IBCNSU41(DFN) 14 F I=0,"M","M1","U","U2" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):(^(I)),1:"") 15 S IBOUTP=2,IBINDT=$S(+$G(IB("U")):+IB("U"),1:DT) 16 ;S Z=1,IBW=1 X IBWW W " Rate Type : ",$S($P(IB(0),U,7)']"":IBU,$D(^DGCR(399.3,$P(IB(0),U,7),0)):$P(^(0),U),1:IBUN) 17 ; 18 S X=" Rate Type : "_$S($P(IB(0),U,7)']"":IBU,$D(^DGCR(399.3,$P(IB(0),U,7),0)):$P(^(0),U),1:IBUN) 19 S Z=1,IBW=1 X IBWW W X 20 I +$P($G(^IBE(350.9,1,1)),U,22) W $J("",(42-$L(X))),"Form Type: ",$P($G(^IBE(353,+$P(IB(0),U,19),0)),U,1) 21 W !?4,"Responsible: ",$S($P(IB(0),U,11)']"":IBU,$P(IB(0),U,11)="p":"PATIENT",$P(IB(0),U,11)="i":"INSURER",1:"OTHER") 22 W ?45,"Payer Sequence: " S IBX=$P(IB(0),U,21) W $S(IBX="P":"Primary",IBX="S":"Secondary",IBX="T":"Tertiary",IBX="A":"Patient",1:"") 23 I $P(IB(0),U,11)="i" D 24 . W !?4,"Bill Payer : " S X=$G(^DGCR(399,IBIFN,"MP")) 25 . W $S(+X:$P($G(^DIC(36,+X,0)),U,1),$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)):"MRA NEEDED FROM MEDICARE",1:IBU) 26 . W ?45,"Transmit: " S Z=0,X=$$TXMT^IBCEF4(IBIFN,.Z) 27 . W $S(X:"Yes",1:"No-"_$S(Z=1:"Forced to print local",Z=2&($$WNRBILL^IBEFUNC(IBIFN)):"MRA not active",Z=2:"EDI not active",Z=3:"Rate typ transmit off",Z=4:"Ins. co transmit off",Z=5:"Failed RULE #"_$G(Z(0)),Z=6:"Invalid NDC code type",1:"??")) 28 I $P(IB(0),U,11)']"" G MAIL 29 I $P(IB(0),U,11)="p" G MAIL 30 I $P(IB(0),U,11)="o" W !?4,"Inst. Name : ",$S($P(IB("M"),U,11)']"":IBU,$D(^DIC(4,$P(IB("M"),U,11),0)):$P(^(0),U,1),1:"UNKNOWN INSTITUTION") G MAIL 31 I $P(IB(0),U,11)="i" I $D(IBDD)>1,$D(^DGCR(399,IBIFN,"AIC")) G SHW 32 D UP G LST:$D(IBDD)>1 W !?4,"Insurance : NO REIMBURSABLE INSURANCE INFORMATION ON FILE",!?17,"[Add Insurance Information by entering '1' at the prompt below]" G MAIL 33 ;W !?4,"Insurance Carrier",?40,"Whose",?66,"Relationship" S X="",$P(X,"=",81)="" W !,X 34 LST N IBDTIN,IBICT 35 S IBDTIN=+$G(IB("U")),IBICT=0 36 W ! D HDR^IBCNS 37 S I=0 F S I=$O(IBDD("S",I)) Q:'I D Q:IBICT'<5 38 .S IBX=0 F S IBX=$O(IBDD("S",I,IBX)) Q:'IBX S IBINS=$G(IBDD(IBX,0)) I IBINS'="" S IBICT=IBICT+1 D:IBICT<5 D1^IBCNS I IBICT'<5 W !,?1,"**Patient has additional insurance - use ?INS to see the entire list" Q 39 G MAIL 40 LST1 W !?4,$S($D(^DIC(36,+IBDD(IBX,0),0)):$E($P(^(0),"^",1),1,20),1:"UNKNOWN") S X=$P(IBDD(IBX,0),"^",6) W ?26,$S(X="v":"VETERAN",X="s":"SPOUSE",1:"OTHER") S X=$P(IBDD(IBX,0),"^",16) 41 S X=$S(+X=1:"PATIENT",+X=2:"SPOUSE",+X=3:"CHILD",+X=8:"EMPLOYEE",+X=11:"ORGAN DONOR",+X=18:"PARENT",+X=15:"PLANTIFF",1:"UNKNOWN") 42 I X="UNKNOWN" S X1=$S($D(IBDD(IBX,0)):$P(IBDD(IBX,0),"^",6),1:""),X=$S(X1="v":"PATIENT",X1="s":"SPOUSE",1:X) 43 W ?37,X,?49 S Y=$P(IBDD(IBX,0),"^",8) X ^DD("DD") W Y,?64 S Y=$P(IBDD(IBX,0),"^",4) X ^DD("DD") W Y 44 Q 45 SHW I $D(IBDD) S I="" F S I=$O(IBDD(I)) Q:'I D SHW1 46 MAIL I $$BUFFER^IBCNBU1(DFN) W !!,?17,"*** Patient has Insurance Buffer entries ***" 47 S IB("M")=$S($D(^DGCR(399,IBIFN,"M")):^("M"),1:""),IB("M1")=$S($D(^DGCR(399,IBIFN,"M1")):^("M1"),1:""),IB(0)=^DGCR(399,IBIFN,0) 48 S Z=2,IBW=1 W ! X IBWW 49 N IBRAMS S IBRAMS=4.06 50 I $$FT^IBCEF(IBIFN)=3 S IBRAMS=4.08 51 S IB("RAFLAG",1)=$S($P(IB("M"),U,1)="":0,1:$$GET1^DIQ(36,$P(IB("M"),U,1),IBRAMS,"I")) 52 S IB("RAFLAG",2)=$S($P(IB("M"),U,2)="":0,1:$$GET1^DIQ(36,$P(IB("M"),U,2),IBRAMS,"I")) 53 S IB("RAFLAG",3)=$S($P(IB("M"),U,3)="":0,1:$$GET1^DIQ(36,$P(IB("M"),U,3),IBRAMS,"I")) 54 S X=0 I $P(IB("M1"),U,2)="",'IB("RAFLAG",1),$P(IB("M1"),U,3)="",'IB("RAFLAG",2),$P(IB("M1"),U,4)="",'IB("RAFLAG",3) S X=1 W " Facility ID #s: ",IBUN 55 I 'X D 56 . W " Primary Payer: ",$S($P(IB("M1"),U,2)]"":$P(IB("M1"),U,2),IB("RAFLAG",1):"ATT/REND ID",1:"") 57 . W !?4,"Secondary Payer: ",$S($P(IB("M1"),U,3)]"":$P(IB("M1"),U,3),IB("RAFLAG",2):"ATT/REND ID",1:"") 58 . W ?45,"Tertiary Payer: ",$S($P(IB("M1"),U,4)]"":$P(IB("M1"),U,4),IB("RAFLAG",3):"ATT/REND ID",1:"") 59 S Z=3,IBW=1 W ! X IBWW 60 W " Mailing Address : " 61 S X=+$G(^DGCR(399,IBIFN,"MP")) 62 I 'X,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S X=+$$CURR^IBCEF2(IBIFN) 63 I X,+$G(^DIC(36,X,3)) S I=$P(^(3),U,$S($$FT^IBCEF(IBIFN)=2:2,1:4)) W ?56,"Electronic ID: ",$S(I'="":I,1:"<NONE>") 64 S X="" I IB("M")]"" F I=4:1:9 Q:X]"" S X=$P(IB("M"),"^",I) 65 I X']"" W !?4,"NO MAILING ADDRESS HAS BEEN SPECIFIED!",?45,$$UP1,!?4,"Send Bill to PAYER listed above." G ENDSCR 66 S X=IB("M") W !,?4,$S($P(X,"^",4)]"":$P(X,"^",4),1:"'MAIL TO' PERSON/PLACE UNSPECIFIED"),?45,$$UP1 67 W !?4,$S($P(X,"^",5)]"":$P(X,"^",5),1:"STREET ADDRESS UNSPECIFIED") W:$P(X,"^",6)]"" ", ",$P(X,"^",6) 68 W ! W:$P(IB("M1"),"^",1)]"" ?4,$P(IB("M1"),"^",1),", " 69 W ?4,$S($P(X,"^",7)]"":$P(X,"^",7),1:"CITY UNSPECIFIED"),", ",$S($D(^DIC(5,+$P(X,"^",8),0)):$P(^(0),"^",2),1:"STATE UNSPECIFIED")," ",$S($P(X,"^",9)]"":$P(X,"^",9),1:"ZIP UNSPECIFIED") 70 ; 71 ENDSCR K IBADI,IBDD,IBOUTP,IBINDT,I,X,X1 72 G ^IBCSCP 73 ; 74 SHW1 S X=IBDD(I,0),Z=$G(^DIC(36,+X,0)) 75 W !!?4,"Ins ",I,": " W $E($S($P(Z,U,1)'="":$P(Z,U,1),1:IBU),1,16) 76 I $P(Z,U,2)="N" W ?30,"WILL NOT REIMBURSE" 77 W ?51,"Policy #: ",$E($S($P(X,"^",2)]"":$P(X,"^",2),1:IBU),1,18) 78 W !?4,"Grp #: ",$E($S($P(X,"^",3)]"":$P(X,"^",3),1:IBU),1,16) 79 W ?30,"Whose: ",$S($P(X,"^",6)="v":"VETERAN",$P(X,"^",6)="s":"SPOUSE",1:"OTHER") 80 W ?51,"Rel to Insd: ",IBIR(I) 81 W !?4,"Grp Nm: ",$E($S($P(X,"^",15)]"":$P(X,"^",15),1:IBU),1,16) 82 W ?30,"Insd Sex: ",$S($D(IBISEX(I)):IBISEX(I),1:IBU) 83 W ?51,"Insured: ",$E($P(X,"^",17),1,19) 84 Q 85 ; 86 UP K IBDD D ALL^IBCNS1(DFN,"IBDD",2,IBINDT,1) 87 I $D(IBDD("S",.5)) D ; At least 1 MCR WNR insurance policy exists 88 . ;try to put correct part (A for institution and B for facility) 89 . N Z,IBAB 90 . S IBAB=$S($$FT^IBCEF(IBIFN)=3:"A",1:"B") 91 . S Z=0 F S Z=$O(IBDD("S",.5,Z)) Q:'Z D 92 .. I $P($G(IBDD(Z,355.3)),U,14)=IBAB S IBDD("S",.1,Z,0)="" K IBDD("S",.5,Z) 93 Q 94 ; 95 UP1() ;check if patient has medicare so can print a flag for the user 96 N IBDD,IBX,IBY S IBY="" D ALL^IBCNS1(DFN,"IBDD",2,IBINDT) 97 S IBX=0 F S IBX=$O(IBDD(IBX)) Q:'IBX I $P($G(IBDD(IBX,355.3)),U,9)=33 S IBY="(Patient has Medicare)" 98 Q IBY 99 ;IBCSC3
Note:
See TracChangeset
for help on using the changeset viewer.
