Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEF12

IBCEF12.m

Go to the documentation of this file.
  1. IBCEF12 ;EDE/JWS - OUTPUT FORMATTER SPECIFIC DENTAL FUNCTIONS ;30-JAN-96
  1. ;;2.0;INTEGRATED BILLING;**592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;JWS;IB*2.0*592;US131
  1. TNUM(IBIFN) ; Extract code for 364.5 field 383 N-TOOTH NUMBER
  1. N IB,IB1
  1. K ^TMP("IBXSAVE",$J,"TO")
  1. ;IA# 3820
  1. S IB=0 F S IB=$O(^DGCR(399,IBIFN,"DEN1",IB)) Q:'IB S IB1=^(IB,0),^TMP("IBXSAVE",$J,"TO",IBIFN,IB)=IB1_U_"JP"
  1. Q
  1. ;
  1. DEN ; Output formatter Format Code for file DEN, field 2
  1. ;JWS;IB*2.0*592;US131
  1. N A,Z,Q,IBZ K IBXSAVE("OUTPT")
  1. D SET1^IBCEF1(IBXIEN,.A,.IBZ,.IBXDATA,.IBXNOREQ)
  1. S (Q,Z)=0 ;,Q=$G(@A)
  1. F S Z=$O(IBZ(Z)) S:'Z @A=Q Q:'Z M IBXSAVE("OUTPT",Z)=IBZ(Z) S Q=Q+1,IBXDATA(Z)=Q D:Z>1 ID^IBCEF2(Z,"DEN ") D SVITM^IBCEF2(.IBXSAVE,Z)
  1. Q
  1. ;
  1. DEN1 ; Output formatter Format Code for file DEN1, field 2
  1. ;JWS;IB*2.0*592;US131
  1. N A,Z,Q,IBZ K IBXSAVE("OUTPT")
  1. D SET1^IBCEF1(IBXIEN,.A,.IBZ,.IBXDATA,.IBXNOREQ)
  1. S (Q,Z)=0 ;,Q=$G(@A)
  1. F S Z=$O(IBZ(Z)) S:'Z @A=Q Q:'Z M IBXSAVE("OUTPT",Z)=IBZ(Z) S Q=Q+1,IBXDATA(Z)=Q D:Z>1 ID^IBCEF2(Z,"DEN1") D SVITM^IBCEF2(.IBXSAVE,Z)
  1. Q
  1. ;
  1. DEN2 ; Output formatter Format Code for file DEN2, fields 2
  1. ;JWS;IB*2.0*592;US131
  1. N A,Z,Z1,CT
  1. D SET1^IBCEF1(IBXIEN,.A,.IBZ,.IBXDATA,.IBXNOREQ)
  1. S (CT,Z)=0 ;,Q=$G(@A)
  1. F S Z=$O(IBZ(Z)) Q:'Z D
  1. . S Z1=0 F S Z1=$O(IBXSAVE("OUTPT",Z,"DEN1",Z1)) Q:'Z1 D I CT=1,$P($G(IBXSAVE("OUTPT",Z)),U,9)'=1 Q
  1. .. S CT=CT+1 D ID^IBCEF2(CT,"DEN2")
  1. .. S IBXDATA(CT)=Z
  1. .. D SETGBL^IBCEFG(IBXPG,CT,2,Z,.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN23 ; Output formatter format code for file DEN2, field 3 (8,186.2,1,3)
  1. ;JWS;IB*2.0*592;US131
  1. N Z,Z0,CT
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. S IBXDATA(CT)="JP"
  1. .. D SETGBL^IBCEFG(IBXPG,CT,3,"JP",.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN24 ; Output formatter Format Code for file DEN2, field 4
  1. ;JWS;IB*2.0*592;US131
  1. N Z,ZO,CT K IBXSAVE("DONE")
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. I $D(IBXSAVE("DONE",Z,Z0)) Q
  1. .. S IBXSAVE("DONE",Z,Z0)=""
  1. .. ;IA# 2056
  1. .. S IBXDATA(CT)=$$GET1^DIQ(356.022,$P(IBXSAVE("OUTPT",Z,"DEN1",Z0,0),U),.01)
  1. .. D SETGBL^IBCEFG(IBXPG,CT,4,IBXDATA(CT),.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN25 ; Output formatter Format Code for file DEN2, field 5
  1. ;JWS;IB*2.0*592;US131
  1. N Z,ZO,CT K IBXSAVE("DONE")
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. I $D(IBXSAVE("DONE",Z,Z0)) Q
  1. .. S IBXSAVE("DONE",Z,Z0)=""
  1. .. S IBXDATA(CT)=$P(IBXSAVE("OUTPT",Z,"DEN1",Z0,0),U,2)
  1. .. D SETGBL^IBCEFG(IBXPG,CT,5,IBXDATA(CT),.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN26 ; Output formatter Format Code for file DEN2, field 6
  1. ;JWS;IB*2.0*592;US131
  1. N Z,ZO,CT K IBXSAVE("DONE")
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. I $D(IBXSAVE("DONE",Z,Z0)) Q
  1. .. S IBXSAVE("DONE",Z,Z0)=""
  1. .. S IBXDATA(CT)=$P(IBXSAVE("OUTPT",Z,"DEN1",Z0,0),U,3)
  1. .. D SETGBL^IBCEFG(IBXPG,CT,6,IBXDATA(CT),.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN27 ; Output formatter Format Code for file DEN2, field 7
  1. ;JWS;IB*2.0*592;US131
  1. N Z,ZO,CT K IBXSAVE("DONE")
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. I $D(IBXSAVE("DONE",Z,Z0)) Q
  1. .. S IBXSAVE("DONE",Z,Z0)=""
  1. .. S IBXDATA(CT)=$P(IBXSAVE("OUTPT",Z,"DEN1",Z0,0),U,4)
  1. .. D SETGBL^IBCEFG(IBXPG,CT,7,IBXDATA(CT),.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN28 ; Output formatter Format Code for file DEN2, field 8
  1. ;JWS;IB*2.0*592;US131
  1. N Z,ZO,CT K IBXSAVE("DONE")
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. I $D(IBXSAVE("DONE",Z,Z0)) Q
  1. .. S IBXSAVE("DONE",Z,Z0)=""
  1. .. S IBXDATA(CT)=$P(IBXSAVE("OUTPT",Z,"DEN1",Z0,0),U,5)
  1. .. D SETGBL^IBCEFG(IBXPG,CT,8,IBXDATA(CT),.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. DEN29 ; Output formatter Format Code for file DEN2, field 9
  1. ;JWS;IB*2.0*592;US131
  1. N Z,ZO,CT K IBXSAVE("DONE")
  1. S (CT,Z)=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S Z0=0 F S Z0=$O(IBXSAVE("OUTPT",Z,"DEN1",Z0)) Q:'Z0 D
  1. .. S CT=CT+1
  1. .. I $D(IBXSAVE("DONE",Z,Z0)) Q
  1. .. S IBXSAVE("DONE",Z,Z0)=""
  1. .. S IBXDATA(CT)=$P(IBXSAVE("OUTPT",Z,"DEN1",Z0,0),U,6)
  1. .. D SETGBL^IBCEFG(IBXPG,CT,9,IBXDATA(CT),.IBXSIZE)
  1. K IBXDATA
  1. Q
  1. ;
  1. TRANS ; Output formatter Format Code for file DN1, field 6
  1. ;JWS;IB*2.0*592;US131; IA# 2056
  1. I $$GET1^DIQ(399,IBXIEN_",",93)'="",$$GET1^DIQ(399,IBXIEN_",",94)'="" K IBXDATA
  1. S IBXDATA=$E($G(IBXDATA)) I IBXDATA'="Y" K IBXDATA
  1. Q
  1. ;
  1. SRVDT ; Output formatter Format Code for file DEN, field 4 Service date
  1. ;JWS;IB*2.0*592;US131
  1. ;;S IBXNOREQ=$$NFT^IBCEF1(7,IBXIEN)
  1. N Z,IBCDT
  1. S IBCDT=$$GET1^DIQ(399,IBXIEN_",",.03,"I"),IBCDT=$$FMTHL7^XLFDT(IBCDT)
  1. S Z=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . I $P($G(IBXSAVE("OUTPT",Z,"DEN")),U,11)'="" Q ;treatment start date
  1. . I $P($G(IBXSAVE("OUTPT",Z,"DEN")),U,12)'="" Q ;treatment completion date
  1. . I $P($G(IBXSAVE("OUTPT",Z)),U)=IBCDT Q ;if procedure date is same as event date, don't send
  1. . I $P($G(IBXSAVE("OUTPT",Z)),U)'="" S IBXDATA(Z)=$P(IBXSAVE("OUTPT",Z),U)
  1. . Q
  1. Q
  1. ;
  1. SRVDTQ ; Output formatter Format Code for file DEN, field 3 Date/Time Qualifier
  1. ;JWS;IB*2.0*592;US131
  1. N Z,IBCDT
  1. S IBCDT=$$GET1^DIQ(399,IBXIEN_",",.03,"I"),IBCDT=$$FMTHL7^XLFDT(IBCDT)
  1. S Z=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . I $P($G(IBXSAVE("OUTPT",Z,"DEN")),U,11)'="" Q ;treatment start date
  1. . I $P($G(IBXSAVE("OUTPT",Z,"DEN")),U,12)'="" Q ;treatment completion date
  1. . I $P($G(IBXSAVE("OUTPT",Z)),U)=IBCDT Q ;if procedure date is same as event date, don't send
  1. . I $P($G(IBXSAVE("OUTPT",Z)),U)'="" S IBXDATA(Z)=472
  1. Q
  1. ;
  1. PROC ; Output formatter Format Code for file DEN1, field 3 Procedure Count
  1. N Z S Z=0
  1. F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z D
  1. . S IBXDATA(Z)=$P($G(IBXSAVE("OUTPT",Z)),U,9)
  1. . I IBXDATA(Z)=1 S IBXDATA(Z)="" ;number of units (default=1, therefore must be blank if =1)
  1. . Q
  1. Q
  1. ;
  1. POS ; Output formatter Format Code for File DEN, field 13 Place of Service
  1. N IBZ,W,DEFPOS,POS,HOF,Z
  1. ;perform logic to obtain CL1-33 Place of Service (Claim Level) to compare to line level
  1. D F^IBCEF("N-HCFA SERVICE LINE CALLABLE","IBZ",,IBXIEN)
  1. S DEFPOS="",W=0
  1. F S W=$O(IBZ(W)) Q:'W S POS=$P($G(IBZ(W)),U,3),HOF=(POS=11!(POS=12)) S:DEFPOS=""!HOF DEFPOS=POS Q:HOF
  1. ;
  1. S Z=0 F S Z=$O(IBXSAVE("OUTPT",Z)) Q:'Z I $P(IBXSAVE("OUTPT",Z),U,3)'="",$P(IBXSAVE("OUTPT",Z),U,3)'=DEFPOS S IBXDATA(Z)=$P(IBXSAVE("OUTPT",Z),U,3)
  1. Q
  1. ;
  1. OIT ; Output formatter Format Code for File OI1, field 8 Other Insurance Type
  1. I $$FT^IBCEF(IBXIEN)'=7 Q
  1. I A'=3 S IBXDATA(Z)=""
  1. Q
  1. ;
  1. CHK(IBIEN) ;DIC("S") screen for OCCURRENCE CODE 399.041, .01 field
  1. N IBCHK
  1. I $D(IBIFN) S IBIEN=IBIFN
  1. I $$FT^IBCEF(IBIEN)'=7 Q 1
  1. S IBCHK=$P($G(^DGCR(399.1,Y,0)),"^",2)
  1. I $F(",01,02,03,04,05,",","_IBCHK_",") Q 1
  1. Q 0
  1. ;