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

BDGCPT1.m

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