- 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
