ABMDVS13 ; IHS/ASDST/DMJ - PCC VISIT STUFF, V CPT code ;
;;2.6;IHS 3P BILLING SYSTEM**9,11**;NOV 12, 2009;;Build 133
;Original;DMJ;
;
; IHS/SD/SDR - 11/04/02 - V2.5 P2 - ZZZ-0301-210046
; Modified to capture modifiers from PCC
;
; IHS/SD/SDR - v2.6 CSV
; IHS/SD/SDR - 2.6*9 - HEAT36314 - Correction for modifiers; was coming back NO SUCH MODIFIER
;
Q:ABMIDONE
START ;START
N ABMDA,ABMCPT,X,ABMCORDI,ABMSRGPR
K AUPNCPT
S X=$$CPT^AUPNCPT(ABMVDFN)
Q:X
D SURGTAB^ABMDVCK1 ;Make sure CPT table exists
S ABMSDT=$P(ABMP("V0"),U)
N SF
;Get corresponding diagnosis
S ABM=0
F S ABM=$O(^AUPNVPRC("AD",ABMVDFN,ABM)) Q:'ABM D
.S Y=^AUPNVPRC(ABM,0)
.Q:$P(Y,U,5)=""
.Q:$P(Y,U,16)=""
.S ABMCORDI($P(Y,U,16))=$P(Y,U,5)
S N=""
F S N=$O(AUPNCPT(N)) Q:N="" D
.S ABMDA=$P(AUPNCPT(N),U,5)
.S SF=$P($P(AUPNCPT(N),U,4),".",2) ;Source file
.S ABMSRC=SF_"|"_ABMDA_"|CPT" ;Source file|ien
.S DA(1)=ABMP("CDFN")
.S ABMCPT=$P(AUPNCPT(N),U)
.S ABMMOD1=$P(AUPNCPT(N),"^",6)
.;I $G(ABMMOD1)'="" S ABMMOD1=$P($$MOD^ABMCVAPI(ABMMOD1,"E",ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*9 HEAT36314
.I $G(ABMMOD1)'="" S ABMMOD1=$P($$MOD^ABMCVAPI(ABMMOD1,"I",ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*9 HEAT36314
.S ABMMOD2=$P(AUPNCPT(N),"^",7)
.;I $G(ABMMOD2)'="" S ABMMOD2=$P($$MOD^ABMCVAPI(ABMMOD2,"E",ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*9 HEAT36314
.I $G(ABMMOD2)'="" S ABMMOD2=$P($$MOD^ABMCVAPI(ABMMOD2,"I",ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*9 HEAT36314
.;The next line is intended to prevent dupes being stuffed into the
.;claim file. It requires that other stuffing rtns put in ABMSRC
.I $D(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC)),(ABMCPT<ABMCPTTB("SURGERY","L"))!(ABMCPT>ABMCPTTB("SURGERY","H")) Q
.;start new code abm*2.6*11 HEAT83923
.I ($P(AUPNCPT(N),U,4)="9000010.08") D
..S ABMAST=$$GET1^DIQ($P(AUPNCPT(N),U,4),$P(AUPNCPT(N),U,5),".19","I") ;Anes. start dt/tm
..S ABMAET=$$GET1^DIQ($P(AUPNCPT(N),U,4),$P(AUPNCPT(N),U,5),".21","I") ;Anes. end dt/tm
.I ($P(AUPNCPT(N),U,4)="9000010.18") D
..S ABMAST=$$GET1^DIQ($P(AUPNCPT(N),U,4),$P(AUPNCPT(N),U,5),".13","I") ;Anes. start dt/tm
..S ABMAET=$$GET1^DIQ($P(AUPNCPT(N),U,4),$P(AUPNCPT(N),U,5),".14","I") ;Anes. end dt/tm
.;end new code HEAT83923
.; Needs ABMCPT, ABMSDT, ABMSRC, & DA(1) OR ABMP("CDFN")
.D ^ABMFCPT
;K ABMSDT,N,AUPNCPT,ABMSRC ;abm*2.6*11 HEAT83923
K ABMSDT,N,AUPNCPT,ABMSRC,ABMAST,ABMAET ;abm*2.6*11 HEAT83923
Q
ABMDVS13 ; IHS/ASDST/DMJ - PCC VISIT STUFF, V CPT code ;
+1 ;;2.6;IHS 3P BILLING SYSTEM**9,11**;NOV 12, 2009;;Build 133
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/SD/SDR - 11/04/02 - V2.5 P2 - ZZZ-0301-210046
+5 ; Modified to capture modifiers from PCC
+6 ;
+7 ; IHS/SD/SDR - v2.6 CSV
+8 ; IHS/SD/SDR - 2.6*9 - HEAT36314 - Correction for modifiers; was coming back NO SUCH MODIFIER
+9 ;
+10 IF ABMIDONE
QUIT
START ;START
+1 NEW ABMDA,ABMCPT,X,ABMCORDI,ABMSRGPR
+2 KILL AUPNCPT
+3 SET X=$$CPT^AUPNCPT(ABMVDFN)
+4 IF X
QUIT
+5 ;Make sure CPT table exists
DO SURGTAB^ABMDVCK1
+6 SET ABMSDT=$PIECE(ABMP("V0"),U)
+7 NEW SF
+8 ;Get corresponding diagnosis
+9 SET ABM=0
+10 FOR
SET ABM=$ORDER(^AUPNVPRC("AD",ABMVDFN,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+11 SET Y=^AUPNVPRC(ABM,0)
+12 IF $PIECE(Y,U,5)=""
QUIT
+13 IF $PIECE(Y,U,16)=""
QUIT
+14 SET ABMCORDI($PIECE(Y,U,16))=$PIECE(Y,U,5)
End DoDot:1
+15 SET N=""
+16 FOR
SET N=$ORDER(AUPNCPT(N))
IF N=""
QUIT
Begin DoDot:1
+17 SET ABMDA=$PIECE(AUPNCPT(N),U,5)
+18 ;Source file
SET SF=$PIECE($PIECE(AUPNCPT(N),U,4),".",2)
+19 ;Source file|ien
SET ABMSRC=SF_"|"_ABMDA_"|CPT"
+20 SET DA(1)=ABMP("CDFN")
+21 SET ABMCPT=$PIECE(AUPNCPT(N),U)
+22 SET ABMMOD1=$PIECE(AUPNCPT(N),"^",6)
+23 ;I $G(ABMMOD1)'="" S ABMMOD1=$P($$MOD^ABMCVAPI(ABMMOD1,"E",ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*9 HEAT36314
+24 ;CSV-c ;abm*2.6*9 HEAT36314
IF $GET(ABMMOD1)'=""
SET ABMMOD1=$PIECE($$MOD^ABMCVAPI(ABMMOD1,"I",ABMP("VDT")),U,2)
+25 SET ABMMOD2=$PIECE(AUPNCPT(N),"^",7)
+26 ;I $G(ABMMOD2)'="" S ABMMOD2=$P($$MOD^ABMCVAPI(ABMMOD2,"E",ABMP("VDT")),U,2) ;CSV-c ;abm*2.6*9 HEAT36314
+27 ;CSV-c ;abm*2.6*9 HEAT36314
IF $GET(ABMMOD2)'=""
SET ABMMOD2=$PIECE($$MOD^ABMCVAPI(ABMMOD2,"I",ABMP("VDT")),U,2)
+28 ;The next line is intended to prevent dupes being stuffed into the
+29 ;claim file. It requires that other stuffing rtns put in ABMSRC
+30 IF $DATA(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC))
IF (ABMCPT<ABMCPTTB("SURGERY","L"))!(ABMCPT>ABMCPTTB("SURGERY","H"))
QUIT
+31 ;start new code abm*2.6*11 HEAT83923
+32 IF ($PIECE(AUPNCPT(N),U,4)="9000010.08")
Begin DoDot:2
+33 ;Anes. start dt/tm
SET ABMAST=$$GET1^DIQ($PIECE(AUPNCPT(N),U,4),$PIECE(AUPNCPT(N),U,5),".19","I")
+34 ;Anes. end dt/tm
SET ABMAET=$$GET1^DIQ($PIECE(AUPNCPT(N),U,4),$PIECE(AUPNCPT(N),U,5),".21","I")
End DoDot:2
+35 IF ($PIECE(AUPNCPT(N),U,4)="9000010.18")
Begin DoDot:2
+36 ;Anes. start dt/tm
SET ABMAST=$$GET1^DIQ($PIECE(AUPNCPT(N),U,4),$PIECE(AUPNCPT(N),U,5),".13","I")
+37 ;Anes. end dt/tm
SET ABMAET=$$GET1^DIQ($PIECE(AUPNCPT(N),U,4),$PIECE(AUPNCPT(N),U,5),".14","I")
End DoDot:2
+38 ;end new code HEAT83923
+39 ; Needs ABMCPT, ABMSDT, ABMSRC, & DA(1) OR ABMP("CDFN")
+40 DO ^ABMFCPT
End DoDot:1
+41 ;K ABMSDT,N,AUPNCPT,ABMSRC ;abm*2.6*11 HEAT83923
+42 ;abm*2.6*11 HEAT83923
KILL ABMSDT,N,AUPNCPT,ABMSRC,ABMAST,ABMAET
+43 QUIT
