ABMDESMR ; IHS/ASDST/DMJ - Summarized Claim RX charges ;
;;2.6;IHS 3P BILLING SYSTEM;**10,13,21,22**;NOV 12, 2009;Build 418
;
;IHS/DSD/LSL - 09/02/98 - Patch 2 - NOIS NDA-0898-180038
; 0.00 charges on HCFA because version 2.0 does not assume 1 for units. Modify code to set units to 1 if not already defined.
;
;IHS/SD/SDR V2.5 P8 - IM10618/IM11164 - Prompt/display provider
;IHS/SD/SDR v2.5 p8 - task 57 - Added code for days supply
;IHS/SD/SDR v2.5 p9 - task 1 - Use new service line provider multiple
;IHS/SD/SDR v2.5 p10 - IM20645 - NDC not printing all the time
;IHS/SD/SDR v2.5 p11 - NPI
;IHS/SD/SDR v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K
;
;IHS/SD/SDR 2.6*13 - Added check for new export mode 35
;IHS/SD/SDR 2.6*21 - HEAT168435 - Added code for pharmacy (23 mult) modifiers to print on claims; also removed drug description,
; removed dashes from NDC, and added UN and units to shaded line.
;IHS/SD/SDR 2.6*22 HEAT329144 Write drug description based on new parameter. NAM prints description, UNT prints units info. Default is NAM.
;
MED ;EP for Medication Charges
Q:$P($G(^AUTNINS(ABMP("INS"),2)),U,3)="U"
Q:$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,997,0)),U,7)="N"
I $G(ABMP("VTYP",997)),'$G(ABMPRINT) Q:ABMP("VTYP",997)'=ABMP("EXP")
S ABMCAT=23 D PCK^ABMDESM1 Q:$G(ABMQUIT)
S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"23,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D MED1
Q
;
MED1 S ABMX(0)=@(ABMP("GL")_"23,"_ABMX("X")_",0)")
S:$D(@(ABMP("GL")_"23,"_ABMX("X")_",2)")) ABMX(2)=@(ABMP("GL")_"23,"_ABMX("X")_",2)") ;abm*2.6*21 IHS/SD/SDR HEAT168435
S ABMZ("UNIT")=$P(ABMX(0),U,3)
S:'+ABMZ("UNIT") ABMZ("UNIT")=1
S ABMX("SUB")=+$FN(ABMZ("UNIT")*$P(ABMX(0),U,4),"T",2)+$P(ABMX(0),U,5)
S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G MEDH
; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code^Drug^Rx #
MEDU ;
S ABMX("R")=$P(ABMX(0),U,2) Q:ABMX("R")=""
I $D(ABMS(ABMX("R"))) S $P(ABMS(ABMX("R")),U)=$P(ABMS(ABMX("R")),U)+ABMX("SUB")
E S ABMS(ABMX("R"))=ABMX("SUB")
Q
;
; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description^RX #^Provider^Days Supply
MEDH S ABMS(ABMS("I"))=ABMX("SUB")
S ABMCAT=23 D HDT^ABMDESM1
;S $P(ABMS(ABMS("I")),U,4)=$P(ABMX(0),U,29) ;cpt ;ABM*2.6*10
S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI($P(ABMX(0),U,29),ABMP("VDT")),U,2) ;abm*2.6*10
;start new abm*2.6*21 IHS/SD/SDR HEAT168435
S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P($G(ABMX(2)),U,3)]"":" "_$P($G(ABMX(2)),U,3),1:"")_$S($P($G(ABMX(2)),U,4)]"":" "_$P($G(ABMX(2)),U,4),1:"")_$S($P($G(ABMX(2)),U,5)]"":" "_$P($G(ABMX(2)),U,5),1:"")
;end new abm*2.6*21 IHS/SD/SDR HEAT168435
S $P(ABMS(ABMS("I")),"^",5)=$P(ABMX(0),"^",13)
S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
S $P(ABMS(ABMS("I")),U,7)=9
S ABMX("D")=$P(ABMX(0),U) D DRUG
S ABMX("C")=$S($P(ABMX(0),U,24)'="":$P(ABMX(0),U,24),1:$P($G(^PSDRUG(+ABMX(0),2)),U,4))
S $P(ABMS(ABMS("I")),U,8)=$S(ABMX("C")]"":ABMX("C")_" ",1:"")
;uncommented below line ;abm*2.6*22 IHS/SD/SDR HEAT329144
S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_$S('$P(ABMX(0),U,7)&'$P(ABMX(0),U,8):ABMX("D"),$P(ABMX(0),U,7):$P(^PS(52.6,$P(ABMX(0),U,7),0),U),1:$P(^PS(52.7,$P(ABMX(0),U,8),0),U)) ;abm*2.6*21 IHS/SD/SDR HEAT168435
;S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_$S('$P(ABMX(0),U,7)&'$P(ABMX(0),U,8):"",$P(ABMX(0),U,7):$P(^PS(52.6,$P(ABMX(0),U,7),0),U),1:$P(^PS(52.7,$P(ABMX(0),U,8),0),U)) ;abm*2.6*21 IHS/SD/SDR HEAT168435 ;abm*2.6*22 IHS/SD/SDR HEAT329144
;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,8)="N4"_$P(ABMS(ABMS("I")),U,8) ;abm*2.6*13 export mode 35 ;abm*2.6*22 IHS/SD/SDR HEAT329144
I ABMP("EXP")=27!(ABMP("EXP")=35) S $P(ABMS(ABMS("I")),U,8)="N4"_$P(ABMS(ABMS("I")),U,8) ;abm*2.6*13 export mode 35 ;abm*2.6*21 IHS/SD/SDR HEAT168435 ;abm*2.6*22 IHS/SD/SDR HEAT329144
;start new abm*2.6*21 IHS/SD/SDR HEAT168435
I ((ABMP("EXP")=27!(ABMP("EXP")=35))&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,21)="UNT")) D ;abm*2.6*22 IHS/SD/SDR HEAT329144
.;S $P(ABMS(ABMS("I")),U,8)="N4"_$TR($P($P(ABMS(ABMS("I")),U,8)," "),"-") ;abm*2.6*13 export mode 35 ;N4 with NDC (dashes removed) ;abm*2.6*22 IHS/SD/SDR HEAT329144
.S $P(ABMS(ABMS("I")),U,8)=$TR($P($P(ABMS(ABMS("I")),U,8)," "),"-") ;abm*2.6*13 export mode 35 ;N4 with NDC (dashes removed) ;abm*2.6*22 IHS/SD/SDR HEAT329144
.S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_$$FMT^ABMERUTL(" ",13)_"UN"_$TR($$FMT^ABMERUTL($FN($P(ABMX(0),U,3),",",3),"11NR"),",.")
;end new abm*2.6*21 IHS/SD/SDR HEAT168435
I $P(ABMX(0),U,9)]"" S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_" "_$P(ABMX(0),U,9)
;I ABMP("EXP")'=27 S $P(ABMS(ABMS("I")),U,9)="RX#-"_$S($P(ABMX(0),U,22)'="":$P(^PSRX($P(ABMX(0),U,22),0),U),1:$P(ABMX(0),"^",6)) ;abm*2.6*13 export mode 35
I ABMP("EXP")'=27&(ABMP("EXP")'=35) S $P(ABMS(ABMS("I")),U,9)="RX#-"_$S($P(ABMX(0),U,22)'="":$P(^PSRX($P(ABMX(0),U,22),0),U),1:$P(ABMX(0),"^",6)) ;abm*2.6*13 export mode 35
S ABMX(0)=@(ABMP("GL")_"23,"_ABMX("X")_",0)")
S ABMDPRV=$O(@(ABMP("GL")_"23,"_ABMX_",""P"",""C"",""R"",0)"))
S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"23,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
I $G(ABMDPRV)="" S ABMDPRV=$$GETPRV^ABMDFUTL
I +$G(ABMDPRV)'=0 D
.Q:'$$K24^ABMDFUTL
.;I ABMP("EXP")'=27 S $P(ABMS(ABMS("I")),U,9)=$P($G(ABMS(ABMS("I"))),U,9)_";;"_$$K24N^ABMDFUTL(ABMDPRV) ;abm*2.6*13 export mode 35
.I ABMP("EXP")'=27&(ABMP("EXP")'=35) S $P(ABMS(ABMS("I")),U,9)=$P($G(ABMS(ABMS("I"))),U,9)_";;"_$$K24N^ABMDFUTL(ABMDPRV) ;abm*2.6*13 export mode 35
.E S $P(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
.S $P(ABMS(ABMS("I")),U,11)=$P($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
.I $G(ABMP("NPIS"))="N" S $P(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)
Q
;
DRUG I ABMX("D")]"" S ABMX("D")=$P($G(^PSDRUG(ABMX("D"),0)),U)
Q
RX I ABMX("C")]"" S ABMX("C")=$P($G(^PSRX(ABMX("C"),0)),U)
Q
ABMDESMR ; IHS/ASDST/DMJ - Summarized Claim RX charges ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,13,21,22**;NOV 12, 2009;Build 418
+2 ;
+3 ;IHS/DSD/LSL - 09/02/98 - Patch 2 - NOIS NDA-0898-180038
+4 ; 0.00 charges on HCFA because version 2.0 does not assume 1 for units. Modify code to set units to 1 if not already defined.
+5 ;
+6 ;IHS/SD/SDR V2.5 P8 - IM10618/IM11164 - Prompt/display provider
+7 ;IHS/SD/SDR v2.5 p8 - task 57 - Added code for days supply
+8 ;IHS/SD/SDR v2.5 p9 - task 1 - Use new service line provider multiple
+9 ;IHS/SD/SDR v2.5 p10 - IM20645 - NDC not printing all the time
+10 ;IHS/SD/SDR v2.5 p11 - NPI
+11 ;IHS/SD/SDR v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K
+12 ;
+13 ;IHS/SD/SDR 2.6*13 - Added check for new export mode 35
+14 ;IHS/SD/SDR 2.6*21 - HEAT168435 - Added code for pharmacy (23 mult) modifiers to print on claims; also removed drug description,
+15 ; removed dashes from NDC, and added UN and units to shaded line.
+16 ;IHS/SD/SDR 2.6*22 HEAT329144 Write drug description based on new parameter. NAM prints description, UNT prints units info. Default is NAM.
+17 ;
MED ;EP for Medication Charges
+1 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U,3)="U"
QUIT
+2 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,997,0)),U,7)="N"
QUIT
+3 IF $GET(ABMP("VTYP",997))
IF '$GET(ABMPRINT)
IF ABMP("VTYP",997)'=ABMP("EXP")
QUIT
+4 SET ABMCAT=23
DO PCK^ABMDESM1
IF $GET(ABMQUIT)
QUIT
+5 SET ABMX=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"23,"_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=ABMX
DO MED1
+6 QUIT
+7 ;
MED1 SET ABMX(0)=@(ABMP("GL")_"23,"_ABMX("X")_",0)")
+1 ;abm*2.6*21 IHS/SD/SDR HEAT168435
IF $DATA(@(ABMP("GL")_"23,"_ABMX("X")_",2)"))
SET ABMX(2)=@(ABMP("GL")_"23,"_ABMX("X")_",2)")
+2 SET ABMZ("UNIT")=$PIECE(ABMX(0),U,3)
+3 IF '+ABMZ("UNIT")
SET ABMZ("UNIT")=1
+4 SET ABMX("SUB")=+$FNUMBER(ABMZ("UNIT")*$PIECE(ABMX(0),U,4),"T",2)+$PIECE(ABMX(0),U,5)
+5 SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
+6 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"
GOTO MEDH
+7 ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code^Drug^Rx #
MEDU ;
+1 SET ABMX("R")=$PIECE(ABMX(0),U,2)
IF ABMX("R")=""
QUIT
+2 IF $DATA(ABMS(ABMX("R")))
SET $PIECE(ABMS(ABMX("R")),U)=$PIECE(ABMS(ABMX("R")),U)+ABMX("SUB")
+3 IF '$TEST
SET ABMS(ABMX("R"))=ABMX("SUB")
+4 QUIT
+5 ;
+6 ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description^RX #^Provider^Days Supply
MEDH SET ABMS(ABMS("I"))=ABMX("SUB")
+1 SET ABMCAT=23
DO HDT^ABMDESM1
+2 ;S $P(ABMS(ABMS("I")),U,4)=$P(ABMX(0),U,29) ;cpt ;ABM*2.6*10
+3 ;abm*2.6*10
SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE($$CPT^ABMCVAPI($PIECE(ABMX(0),U,29),ABMP("VDT")),U,2)
+4 ;start new abm*2.6*21 IHS/SD/SDR HEAT168435
+5 SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE($GET(ABMX(2)),U,3)]"":" "_$PIECE($GET(ABMX(2)),U,3),1:"")_$SELECT(...
... $PIECE($GET(ABMX(2)),U,4)]"":" "_$PIECE($GET(ABMX(2)),U,4),1:"")_$SELECT($PIECE($GET(ABMX(2)),U,5)]"":" "_$PIECE($GET(ABMX(2)),U,5),1:"")
+6 ;end new abm*2.6*21 IHS/SD/SDR HEAT168435
+7 SET $PIECE(ABMS(ABMS("I")),"^",5)=$PIECE(ABMX(0),"^",13)
+8 SET $PIECE(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
+9 SET $PIECE(ABMS(ABMS("I")),U,7)=9
+10 SET ABMX("D")=$PIECE(ABMX(0),U)
DO DRUG
+11 SET ABMX("C")=$SELECT($PIECE(ABMX(0),U,24)'="":$PIECE(ABMX(0),U,24),1:$PIECE($GET(^PSDRUG(+ABMX(0),2)),U,4))
+12 SET $PIECE(ABMS(ABMS("I")),U,8)=$SELECT(ABMX("C")]"":ABMX("C")_" ",1:"")
+13 ;uncommented below line ;abm*2.6*22 IHS/SD/SDR HEAT329144
+14 ;abm*2.6*21 IHS/SD/SDR HEAT168435
SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE(ABMS(ABMS("I")),U,8)_$SELECT('$PIECE(ABMX(0),U,7)&'$PIECE(ABMX(0),U,8):ABMX("D"),$PIECE(ABMX(0),U,7):$PIECE(^PS(52.6,$PIECE(ABMX(0),U,7),0),U),1:$PIECE(^PS(52.7,$PIECE(ABMX(0),U,8),0),U))
+15 ;S $P(ABMS(ABMS("I")),U,8)=$P(ABMS(ABMS("I")),U,8)_$S('$P(ABMX(0),U,7)&'$P(ABMX(0),U,8):"",$P(ABMX(0),U,7):$P(^PS(52.6,$P(ABMX(0),U,7),0),U),1:$P(^PS(52.7,$P(ABMX(0),U,8),0),U)) ;abm*2.6*21 IHS/SD/SDR HEAT168435 ;abm*2.6*22 IHS/SD/SDR HEAT3291
44
+16 ;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,8)="N4"_$P(ABMS(ABMS("I")),U,8) ;abm*2.6*13 export mode 35 ;abm*2.6*22 IHS/SD/SDR HEAT329144
+17 ;abm*2.6*13 export mode 35 ;abm*2.6*21 IHS/SD/SDR HEAT168435 ;abm*2.6*22 IHS/SD/SDR HEAT329144
IF ABMP("EXP")=27!(ABMP("EXP")=35)
SET $PIECE(ABMS(ABMS("I")),U,8)="N4"_$PIECE(ABMS(ABMS("I")),U,8)
+18 ;start new abm*2.6*21 IHS/SD/SDR HEAT168435
+19 ;abm*2.6*22 IHS/SD/SDR HEAT329144
IF ((ABMP("EXP")=27!(ABMP("EXP")=35))&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,21)="UNT"))
Begin DoDot:1
+20 ;S $P(ABMS(ABMS("I")),U,8)="N4"_$TR($P($P(ABMS(ABMS("I")),U,8)," "),"-") ;abm*2.6*13 export mode 35 ;N4 with NDC (dashes removed) ;abm*2.6*22 IHS/SD/SDR HEAT329144
+21 ;abm*2.6*13 export mode 35 ;N4 with NDC (dashes removed) ;abm*2.6*22 IHS/SD/SDR HEAT329144
SET $PIECE(ABMS(ABMS("I")),U,8)=$TRANSLATE($PIECE($PIECE(ABMS(ABMS("I")),U,8)," "),"-")
+22 SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE(ABMS(ABMS("I")),U,8)_$$FMT^ABMERUTL(" ",13)_"UN"_$TRANSLATE($$FMT^ABMERUTL($FNUMBER($PIECE(ABMX(0),U,3),",",3),"11NR"),",.")
End DoDot:1
+23 ;end new abm*2.6*21 IHS/SD/SDR HEAT168435
+24 IF $PIECE(ABMX(0),U,9)]""
SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE(ABMS(ABMS("I")),U,8)_" "_$PIECE(ABMX(0),U,9)
+25 ;I ABMP("EXP")'=27 S $P(ABMS(ABMS("I")),U,9)="RX#-"_$S($P(ABMX(0),U,22)'="":$P(^PSRX($P(ABMX(0),U,22),0),U),1:$P(ABMX(0),"^",6)) ;abm*2.6*13 export mode 35
+26 ;abm*2.6*13 export mode 35
IF ABMP("EXP")'=27&(ABMP("EXP")'=35)
SET $PIECE(ABMS(ABMS("I")),U,9)="RX#-"_$SELECT($PIECE(ABMX(0),U,22)'="":$PIECE(^PSRX($PIECE(ABMX(0),U,22),0),U),1:$PIECE(ABMX(0),"^",6))
+27 SET ABMX(0)=@(ABMP("GL")_"23,"_ABMX("X")_",0)")
+28 SET ABMDPRV=$ORDER(@(ABMP("GL")_"23,"_ABMX_",""P"",""C"",""R"",0)"))
+29 IF +ABMDPRV'=0
SET ABMDPRV=$PIECE($GET(@(ABMP("GL")_"23,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
+30 IF $GET(ABMDPRV)=""
SET ABMDPRV=$$GETPRV^ABMDFUTL
+31 IF +$GET(ABMDPRV)'=0
Begin DoDot:1
+32 IF '$$K24^ABMDFUTL
QUIT
+33 ;I ABMP("EXP")'=27 S $P(ABMS(ABMS("I")),U,9)=$P($G(ABMS(ABMS("I"))),U,9)_";;"_$$K24N^ABMDFUTL(ABMDPRV) ;abm*2.6*13 export mode 35
+34 ;abm*2.6*13 export mode 35
IF ABMP("EXP")'=27&(ABMP("EXP")'=35)
SET $PIECE(ABMS(ABMS("I")),U,9)=$PIECE($GET(ABMS(ABMS("I"))),U,9)_";;"_$$K24N^ABMDFUTL(ABMDPRV)
+35 IF '$TEST
SET $PIECE(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
+36 SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
+37 IF $GET(ABMP("NPIS"))="N"
SET $PIECE(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)
End DoDot:1
+38 QUIT
+39 ;
DRUG IF ABMX("D")]""
SET ABMX("D")=$PIECE($GET(^PSDRUG(ABMX("D"),0)),U)
+1 QUIT
RX IF ABMX("C")]""
SET ABMX("C")=$PIECE($GET(^PSRX(ABMX("C"),0)),U)
+1 QUIT
