BDGCPT1 ; IHS/ANMC/LJF - MORE CPT CODES FOR INPT STAY ;
;;5.3;PIMS;;APR 26, 2002
;
;continuation of code in BDGCPT
;
AMB ;EP; find all ambulatory visits within hosp date range
NEW DGADM,DGDSC,DGDT,DGVN,DGBEG,DGI
S DGADM=$$GET1^DIQ(9000010,DGV,.01,"I")\1 ;admit date
S DGBEG=$$FMADD^XLFDT(DGADM,-3) ;72/24 rule
S DGDSC=$$GET1^DIQ(9000010.02,+$O(^AUPNVINP("AD",DGV,0)),.01,"I")
I DGDSC="" S DGDSC=DT
S DGBEG=(9999999-DGBEG)_".9999999",(DGDSC,DGDT)=9999999-DGDSC
;
F S DGDT=$O(^AUPNVSIT("AA",DFN,DGDT)) Q:'DGDT Q:(DGDT>DGBEG) D
. S DGVN=0 F S DGVN=$O(^AUPNVSIT("AA",DFN,DGDT,DGVN)) Q:'DGVN D
.. I "HICE"[$$GET1^DIQ(9000010,DGVN,.07,"I") Q
.. S DGVV=DGVN
.. ;
.. ; if medicare sheet only pull radiology, tran codes and cpt codes
.. I BDGFIN=3 F DGI="RAD","TRAN","CPT" S DGI=DGI_"^BDGCPT" D @DGI I 1
.. ;
.. ; else, pull all categories
.. E F DGI="CPT","TRAN","RAD","MED","SUP","LAB","IMM" S DGI=DGI_"^BDGCPT" D @DGI
.. ;
.. ; and display basic visit info on each amb visit
.. I BDGFIN=2 D VSIT
Q
;
VSIT ; -- find visit data
NEW DGN,LINE,FIRST,CNT,ARRPOV,ARRPRC,ARRPRV,X
S LINE=$$FMTE^XLFDT(9999999-$P(DGDT,".")_"."_$P(DGDT,".",2))
S LINE=$$PAD(LINE,20)_"Type/Clinic: "
S LINE=LINE_$E($$GET1^DIQ(9000010,DGVV,.07),1,15)
S X=$E($$GET1^DIQ(9000010,DGVV,.08),1,15) S:X="" X="NONE"
S LINE=LINE_"/"_X
;
; -- find providers for visit
S (CNT,DGN)=0
F S DGN=$O(^AUPNVPRV("AD",DGVV,DGN)) Q:'DGN D
. S X=$E($$GET1^DIQ(9000010.06,DGN,.01),1,17) ;provider name
. I $$GET1^DIQ(9000010.06,DGN,.04,"I")="P" S LINE=$$PAD(LINE,63)_X Q
. S CNT=CNT+1,ARRPRV(CNT)=X
;
D SET(LINE,"VSIT",DGDT,DGVV)
;
; -- find dx for visit
S (CNT,DGN)=0
F S DGN=$O(^AUPNVPOV("AD",DGVV,DGN)) Q:'DGN D
. S CNT=CNT+1,ARRPOV(CNT)=$$GET1^DIQ(9000010.07,DGN,.01)
. S ARRPOV(CNT)=$$PAD(ARRPOV(CNT),10)_$E($$GET1^DIQ(9000010.07,DGN,.04),1,30)
I '$D(ARRPOV) S ARRPOV(1)="**UNCODED VISIT**"
;
; -- display all dx and other providers
S (CNT,HIGH)=0
F S CNT=$O(ARRPOV(CNT)) Q:'CNT D
. S HIGH=CNT,LINE=$$PAD($$SP(20)_ARRPOV(CNT),63)_$G(ARRPRV(CNT))
. D SET(LINE,"VSIT",DGDT,DGN_":"_CNT)
;
S CNT=HIGH
F S CNT=$O(ARRPRV(CNT)) Q:'CNT D
. S LINE=$$SP(63)_ARRPRV(CNT) D SET(LINE,"VSIT",DGDT,DGN_":"_CNT)
Q
;
;
PRV ; -- find all v provider entries for hospitalization
NEW DGN,DGDT,LINE
S DGN=0 F S DGN=$O(^AUPNVPRV("AD",DGVV,DGN)) Q:'DGN D
. I $E($$GET1^DIQ(9000010.06,DGN,.019),2,3)="88" Q ;coder
. S DGDT=$$DATE^BDGCPT(9000010.06,DGN),LINE=$$FMTE^XLFDT(DGDT,"D")
. S LINE=$$PAD(LINE,15)_$$GET1^DIQ(9000010.06,DGN,.01)
. S LINE=$$PAD(LINE,40)_" "_$$GET1^DIQ(9000010.06,DGN,.04)
. S LINE=LINE_"/"_$$GET1^DIQ(9000010.06,DGN,.05)
. D SET(LINE,"PRV",DGDT,DGN)
Q
;
;
TRAN ; -- find all trans codes & display in M/M format
NEW DGN,DGDT,LINE,TRAN
S DGN=0 F S DGN=$O(^AUPNVTC("AD",DGVV,DGN)) Q:'DGN D
. Q:$$GET1^DIQ(9000010.33,DGN,.07)="" ;only entries with CPT codes
. S DGDT=$$DATE^BDGCPT(9000010.33,DGN),LINE=$$FMTE^XLFDT(DGDT,"D")
. S LINE=$$PAD(LINE,15)_"CPT: "_$$GET1^DIQ(9000010.33,DGN,.07)
. S LINE=$$PAD(LINE_$$GET1^DIQ(9000010.33,DGN,.08),27) ;cpt modfier
. S TRAN=$$GET1^DIQ(9000010.33,DGN,.01)
. S LINE=LINE_" "_$E($$GET1^DIQ(9000010.33,DGN,.11),1,23)
. S LINE=$$PAD(LINE,54)_"DX:"
. S LINE=$$PAD(LINE,60)_$E($$GET1^DIQ(9000010.33,DGN,1204),1,20)
. D SET(LINE,"CPT",DGDT,DGN) ;save in CPT section
Q
;
SET(LINE,SECTION,DATE,IEN) ; -- put display line into date order under section
S ^TMP("BDGCPT",$J,SECTION,DATE,IEN)=$E(LINE,1,80)
Q
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
BDGCPT1 ; IHS/ANMC/LJF - MORE CPT CODES FOR INPT STAY ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
+3 ;continuation of code in BDGCPT
+4 ;
AMB ;EP; find all ambulatory visits within hosp date range
+1 NEW DGADM,DGDSC,DGDT,DGVN,DGBEG,DGI
+2 ;admit date
SET DGADM=$$GET1^DIQ(9000010,DGV,.01,"I")\1
+3 ;72/24 rule
SET DGBEG=$$FMADD^XLFDT(DGADM,-3)
+4 SET DGDSC=$$GET1^DIQ(9000010.02,+$ORDER(^AUPNVINP("AD",DGV,0)),.01,"I")
+5 IF DGDSC=""
SET DGDSC=DT
+6 SET DGBEG=(9999999-DGBEG)_".9999999"
SET (DGDSC,DGDT)=9999999-DGDSC
+7 ;
+8 FOR
SET DGDT=$ORDER(^AUPNVSIT("AA",DFN,DGDT))
IF 'DGDT
QUIT
IF (DGDT>DGBEG)
QUIT
Begin DoDot:1
+9 SET DGVN=0
FOR
SET DGVN=$ORDER(^AUPNVSIT("AA",DFN,DGDT,DGVN))
IF 'DGVN
QUIT
Begin DoDot:2
+10 IF "HICE"[$$GET1^DIQ(9000010,DGVN,.07,"I")
QUIT
+11 SET DGVV=DGVN
+12 ;
+13 ; if medicare sheet only pull radiology, tran codes and cpt codes
+14 IF BDGFIN=3
FOR DGI="RAD","TRAN","CPT"
SET DGI=DGI_"^BDGCPT"
DO @DGI
IF 1
+15 ;
+16 ; else, pull all categories
+17 IF '$TEST
FOR DGI="CPT","TRAN","RAD","MED","SUP","LAB","IMM"
SET DGI=DGI_"^BDGCPT"
DO @DGI
+18 ;
+19 ; and display basic visit info on each amb visit
+20 IF BDGFIN=2
DO VSIT
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
VSIT ; -- find visit data
+1 NEW DGN,LINE,FIRST,CNT,ARRPOV,ARRPRC,ARRPRV,X
+2 SET LINE=$$FMTE^XLFDT(9999999-$PIECE(DGDT,".")_"."_$PIECE(DGDT,".",2))
+3 SET LINE=$$PAD(LINE,20)_"Type/Clinic: "
+4 SET LINE=LINE_$EXTRACT($$GET1^DIQ(9000010,DGVV,.07),1,15)
+5 SET X=$EXTRACT($$GET1^DIQ(9000010,DGVV,.08),1,15)
IF X=""
SET X="NONE"
+6 SET LINE=LINE_"/"_X
+7 ;
+8 ; -- find providers for visit
+9 SET (CNT,DGN)=0
+10 FOR
SET DGN=$ORDER(^AUPNVPRV("AD",DGVV,DGN))
IF 'DGN
QUIT
Begin DoDot:1
+11 ;provider name
SET X=$EXTRACT($$GET1^DIQ(9000010.06,DGN,.01),1,17)
+12 IF $$GET1^DIQ(9000010.06,DGN,.04,"I")="P"
SET LINE=$$PAD(LINE,63)_X
QUIT
+13 SET CNT=CNT+1
SET ARRPRV(CNT)=X
End DoDot:1
+14 ;
+15 DO SET(LINE,"VSIT",DGDT,DGVV)
+16 ;
+17 ; -- find dx for visit
+18 SET (CNT,DGN)=0
+19 FOR
SET DGN=$ORDER(^AUPNVPOV("AD",DGVV,DGN))
IF 'DGN
QUIT
Begin DoDot:1
+20 SET CNT=CNT+1
SET ARRPOV(CNT)=$$GET1^DIQ(9000010.07,DGN,.01)
+21 SET ARRPOV(CNT)=$$PAD(ARRPOV(CNT),10)_$EXTRACT($$GET1^DIQ(9000010.07,DGN,.04),1,30)
End DoDot:1
+22 IF '$DATA(ARRPOV)
SET ARRPOV(1)="**UNCODED VISIT**"
+23 ;
+24 ; -- display all dx and other providers
+25 SET (CNT,HIGH)=0
+26 FOR
SET CNT=$ORDER(ARRPOV(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+27 SET HIGH=CNT
SET LINE=$$PAD($$SP(20)_ARRPOV(CNT),63)_$GET(ARRPRV(CNT))
+28 DO SET(LINE,"VSIT",DGDT,DGN_":"_CNT)
End DoDot:1
+29 ;
+30 SET CNT=HIGH
+31 FOR
SET CNT=$ORDER(ARRPRV(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+32 SET LINE=$$SP(63)_ARRPRV(CNT)
DO SET(LINE,"VSIT",DGDT,DGN_":"_CNT)
End DoDot:1
+33 QUIT
+34 ;
+35 ;
PRV ; -- find all v provider entries for hospitalization
+1 NEW DGN,DGDT,LINE
+2 SET DGN=0
FOR
SET DGN=$ORDER(^AUPNVPRV("AD",DGVV,DGN))
IF 'DGN
QUIT
Begin DoDot:1
+3 ;coder
IF $EXTRACT($$GET1^DIQ(9000010.06,DGN,.019),2,3)="88"
QUIT
+4 SET DGDT=$$DATE^BDGCPT(9000010.06,DGN)
SET LINE=$$FMTE^XLFDT(DGDT,"D")
+5 SET LINE=$$PAD(LINE,15)_$$GET1^DIQ(9000010.06,DGN,.01)
+6 SET LINE=$$PAD(LINE,40)_" "_$$GET1^DIQ(9000010.06,DGN,.04)
+7 SET LINE=LINE_"/"_$$GET1^DIQ(9000010.06,DGN,.05)
+8 DO SET(LINE,"PRV",DGDT,DGN)
End DoDot:1
+9 QUIT
+10 ;
+11 ;
TRAN ; -- find all trans codes & display in M/M format
+1 NEW DGN,DGDT,LINE,TRAN
+2 SET DGN=0
FOR
SET DGN=$ORDER(^AUPNVTC("AD",DGVV,DGN))
IF 'DGN
QUIT
Begin DoDot:1
+3 ;only entries with CPT codes
IF $$GET1^DIQ(9000010.33,DGN,.07)=""
QUIT
+4 SET DGDT=$$DATE^BDGCPT(9000010.33,DGN)
SET LINE=$$FMTE^XLFDT(DGDT,"D")
+5 SET LINE=$$PAD(LINE,15)_"CPT: "_$$GET1^DIQ(9000010.33,DGN,.07)
+6 ;cpt modfier
SET LINE=$$PAD(LINE_$$GET1^DIQ(9000010.33,DGN,.08),27)
+7 SET TRAN=$$GET1^DIQ(9000010.33,DGN,.01)
+8 SET LINE=LINE_" "_$EXTRACT($$GET1^DIQ(9000010.33,DGN,.11),1,23)
+9 SET LINE=$$PAD(LINE,54)_"DX:"
+10 SET LINE=$$PAD(LINE,60)_$EXTRACT($$GET1^DIQ(9000010.33,DGN,1204),1,20)
+11 ;save in CPT section
DO SET(LINE,"CPT",DGDT,DGN)
End DoDot:1
+12 QUIT
+13 ;
SET(LINE,SECTION,DATE,IEN) ; -- put display line into date order under section
+1 SET ^TMP("BDGCPT",$JOB,SECTION,DATE,IEN)=$EXTRACT(LINE,1,80)
+2 QUIT
+3 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
