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

BSDX41K.m

Go to the documentation of this file. 
  1. BSDX41K ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1. MRR ; ******************** MOST RECENT RADIOLOGY * 9000010.22 *******
  1.  Q:'$D(^AUPNVRAD("AA",APCHSPAT))
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  ;X:'APCHSNPG APCHSBRK
  1.  ; <SETUP>
  1.  ; <PROCESS>
  1.  D RBLD,RPRT
  1.  ; <CLEANUP>
  1.  ;now display RAD refusals
  1.  S APCHST="RADIOLOGY EXAM",APCHSFN=71 D DISPREF^BSDX41F
  1.  K APCHST,APCHSFN
  1. MRRX K APCHSRT,APCHSRR,APCHSRTX,APCHSRRT,APCHSMXL,APCHSRL,APCHSRW,APCHSNMX,APCHSDFN,APCHSIVD,APCHSRTD,APCHSN,APCHSDCD,APCHSEDT,Y
  1.  Q
  1.  ; <BUILD>
  1. RBLD K APCHSRRT S APCHSMXL=0
  1.  S APCHSRRT="" F APCHSQ=0:0 S APCHSRRT=$O(^AUPNVRAD("AA",APCHSPAT,APCHSRRT)) Q:APCHSRRT=""  D RDATE
  1.  Q
  1. RDATE S APCHSIVD=$O(^AUPNVRAD("AA",APCHSPAT,APCHSRRT,0)) S APCHSDFN=$O(^(APCHSIVD,0)) D:APCHSIVD&(APCHSIVD'>APCHSDLM) RSET
  1.  Q
  1. RSET S APCHSN=^AUPNVRAD(APCHSDFN,0),APCHSRR=$G(^AUPNVRAD(APCHSDFN,11))
  1.  ;I APCHSRR]"",$P(APCHSN,U,5)=1 S APCHSRR=APCHSRR_" (ABNORMAL)"
  1.  ;I APCHSRR="",$P(APCHSN,U,5)=1 S APCHSRR="(ABNORMAL)"
  1.  S APCHSEDT=$P($G(^AUPNVRAD(APCHSDFN,12)),U) ;NEW LINE!
  1.  S X=$P(APCHSN,U,5),X=$$EXTSET^XBFUNC(9000010.22,.05,X) S APCHSDCD=X
  1.  ;S APCHSRRT(APCHSRRT)=(-APCHSIVD\1+9999999)_U_APCHSRR S APCHSRTX=$P(^RAMIS(71,APCHSRRT,0),U,1) S:$L(APCHSRTX)>APCHSMXL APCHSMXL=$L(APCHSRTX) ;ORIG LINE
  1.  S APCHSRRT(APCHSRRT)=(-APCHSIVD\1+9999999)_U_APCHSRR_U_APCHSEDT_U_APCHSDCD_U_$$VAL^XBDIQ1(9000010.22,APCHSDFN,.06)
  1.  S APCHSRTX=$P(^RAMIS(71,APCHSRRT,0),U,1) S:$L(APCHSRTX)>APCHSMXL APCHSMXL=$L(APCHSRTX)
  1.  Q
  1.  ; <PRINT>
  1. RPRT S APCHSRW=APCHSMXL+1,APCHSRL=10,APCHSNMX=(IOM-1-APCHSRW)\APCHSRL
  1.  S APCHSRT="" F APCHSQ=0:0 S APCHSRT=$O(APCHSRRT(APCHSRT)) Q:APCHSRT=""  D RPRT2
  1.  Q
  1. RPRT2 ;
  1.  S Y=$P(APCHSRRT(APCHSRT),U,1),APCHSRR=$P(APCHSRRT(APCHSRT),U,2) X APCHSCVD S APCHSRTD=Y
  1.  S APCHSEDT=$P($G(APCHSRRT(APCHSRT)),U,3) I APCHSEDT]"" S Y=$P(APCHSEDT,".") X APCHSCVD S APCHSEDT=Y
  1.  ;S APCHSRTX=$P(^RAMIS(71,APCHSRT,0),U,1) X APCHSCKP Q:$D(APCHSQIT)  W APCHSRTX,?APCHSRW,"(",APCHSRTD,")  ",APCHSRR,!
  1.  S APCHSRTX=$P(^RAMIS(71,APCHSRT,0),U,1)
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  S BSDXTMP=APCHSRTX_$$FILL^BSDX41(APCHSRW-$L(APCHSRTX))_"("_$S(APCHSEDT]"":APCHSEDT,1:APCHSRTD)_")  "
  1.  I $P(APCHSRRT(APCHSRT),U,4)]"" S BSDXTMP=BSDXTMP_"RESULT:  " S APCHSDCD=$P(APCHSRRT(APCHSRT),U,4) S BSDXTMP=BSDXTMP_$S(APCHSDCD]"":APCHSDCD,1:"<none recorded>")
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  I $P(APCHSRRT(APCHSRT),U,5)]"" S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="  "_"Diagnostic Code: "_$P(APCHSRRT(APCHSRT),U,5)_$C(30)
  1.  S BSDXTMP="  "_"IMPRESSION:  " S APCHSICL=16,APCHSNRQ=APCHSRR,APCHSTXT="",APCHSICD="" D PRTTXT^BSDX41F
  1.  K APCHSTXT,APCHSNRQ
  1.  Q
  1.  ;
  1.  ; MOST RECENT EXAMINATION OF EACH TYPE WITHIN DATE RANGE
  1.  ;
  1. MRE ; ******************** MOST RECENT EXAMINATION * 9000010.13 *******
  1.  ;I '$D(^AUPNVXAM("AA",APCHSPAT)),'$D(^AUPNPREF("AA",APCHSPAT,9999999.15)) Q
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  ;X:'APCHSNPG APCHSBRK
  1.  ; <SETUP>
  1.  ; <PROCESS>
  1.  ;D EBLD,EPRT
  1.  D EBLDNEW,EPRTNEW
  1.  ; <CLEANUP>
  1.  ;NOW DISPLAY EXAM REFUSALS
  1.  Q:'$D(^AUPNPREF("AA",APCHSPAT,9999999.15))
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S APCHSFN=9999999.15,APCHST="EXAM"
  1.  D DISPREF
  1. MREX K APCHSET,APCHSER,APCHSETX,APCHSERT,APCHSMXL,APCHSRL,APCHSRW,APCHSNMX,APCHSDFN,APCHSIVD,APCHSETD,APCHSN,Y
  1.  K APCHEIEN,APCHP,APCHSD
  1.  Q
  1. DISPREF ;EP
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S APCHSRC=0
  1.  S APCHSX="" F  S APCHSX=$O(^AUPNPREF("AA",APCHSPAT,APCHSFN,APCHSX)) Q:APCHSX=""!($D(APCHSQIT))  D
  1.  .S APCHSD=0 F  S APCHSD=$O(^AUPNPREF("AA",APCHSPAT,APCHSFN,APCHSX,APCHSD)) Q:APCHSD=""!(APCHSD>APCHSDLM)!($D(APCHSQIT))  D
  1.  ..S APCHSI=0 F  S APCHSI=$O(^AUPNPREF("AA",APCHSPAT,APCHSFN,APCHSX,APCHSD,APCHSI)) Q:APCHSI=""!($D(APCHSQIT))  D
  1.  ...I $D(APCHSS) X APCHSS Q:'%
  1.  ...S APCHSRC=APCHSRC+1
  1.  ...I APCHSRC=1 I APCHST]"" S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30) S BSDXTMP=APCHST_" Refusals "_$C(30)
  1.  ...;X APCHSCKP Q:$D(APCHSQIT)
  1.  ...S BSDXTMP=$$VAL^XBDIQ1(9000022,APCHSI,.04)_" -- "_$$VAL^XBDIQ1(9000022,APCHSI,.07)
  1.  ...S BSDXTMP=BSDXTMP_$$FILL^BSDX41(59-$L(BSDXTMP))_"("_$$DATE^APCHSMU(9999999-APCHSD)_")"
  1.  ..Q
  1.  .Q
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  K APCHST,APCHSX,APCHSD,APCHSS,APCHSFN,APCHSI
  1.  Q
  1.  ; <BUILD>
  1.  ;
  1. EBLDNEW ;new exam section that looks at dx, procedures, cpts in addition to exam
  1.  K APCHSERT
  1.  S APCHEIEN=0 F  S APCHEIEN=$O(^AUTTEXAM(APCHEIEN)) Q:APCHEIEN'=+APCHEIEN  D
  1.  .S APCHECOD=$P(^AUTTEXAM(APCHEIEN,0),U,2)
  1.  .I APCHECOD="" S Y=$$VXAM(APCHSPAT,(9999999-APCHSDLM),DT,APCHEIEN) D SEXAM Q  ;just V EXAM
  1.  .;now see if there is a special routine to get the last of this code
  1.  .I APCHECOD="01" S Y=$$LASTEX01(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="02" S Y=$$LASTEX02(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="04" S Y=$$LASTEX04(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="06" S Y=$$LASTEX06(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="07" S Y=$$LASTEX07(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="08" S Y=$$LASTEX08(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="11" S Y=$$LASTEX11(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="12" S Y=$$LASTEX12(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="14" S Y=$$LASTEX14(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="15" S Y=$$LASTEX15(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="16" S Y=$$LASTEX16(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="17" S Y=$$LASTEX17(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="19" S Y=$$LASTEX19(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="21" S Y=$$LASTEX21(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .I APCHECOD="23" S Y=$$LASTEX23(APCHSPAT,(9999999-APCHSDLM),DT) D SEXAM Q
  1.  .S Y=$$VXAM(APCHSPAT,(9999999-APCHSDLM),DT,APCHEIEN) D SEXAM
  1.  .Q
  1.  Q
  1.  ;
  1. EPRTNEW ;
  1.  S APCHEXT=0 F  S APCHEXT=$O(APCHSERT(APCHEXT)) Q:APCHEXT=""!($D(APCHSQIT))  D
  1.  .S APCHSN=$S($P($G(^AUTTEXAM(APCHEXT,0)),U,2)=34:"DOMESTIC VIOLENCE SCREENING",1:$E($P($G(^AUTTEXAM(APCHEXT,0)),U),1,28))
  1.  .I $P(APCHSERT(APCHEXT),U,2)'["Exam" S APCHSN=$E(APCHSN,1,22)_" ["_$P(APCHSERT(APCHEXT),U,2)_"]"
  1.  .S Y=$P(APCHSERT(APCHEXT),U,1) X APCHSCVD S APCHSD=Y
  1.  .S APCHSER=$P(APCHSERT(APCHEXT),U,3)
  1.  .S APCHP=$E($P(APCHSERT(APCHEXT),U,4),1,15)
  1.  .;X APCHSCKP
  1.  .;Q:$D(APCHSQIT)
  1.  .S BSDXTMP=APCHSN_$$FILL^BSDX41(36-$L(APCHSN))_APCHSD
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(46-$L(BSDXTMP))_APCHSER
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(64-$L(BSDXTMP))_APCHP
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  .Q
  1.  Q
  1. VXAM(P,BD,ED,E) ;
  1.  S ED=$G(ED)
  1.  NEW D,I
  1.  S D=$O(^AUPNVXAM("AA",P,E,0))
  1.  I D="" Q ""
  1.  I (9999999-D)<BD Q ""  ;before date limits
  1.  S I=$O(^AUPNVXAM("AA",P,E,D,0))
  1.  Q (9999999-D)_"^"_"Exam code "_$P(^AUTTEXAM(E,0),U,2)_"^"_$$VAL^XBDIQ1(9000010.13,I,.04)_"^"_$$VAL^XBDIQ1(9000010.13,I,1204)_"^"_$$VAL^XBDIQ1(9000010.13,I,81101)
  1.  ;
  1. SEXAM ;
  1.  I Y="" Q
  1.  S APCHSERT(APCHEIEN)=Y
  1.  Q
  1.  ;
  1. LASTEX01(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"01",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 01^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V70.0",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V70.0"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V70.3")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V70.3"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V70.9")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V70.9"
  1.  S D=$$CPT^APCHSMU2(P,BD,DT,$O(^ATXAX("B","APCH GENERAL EXAM CPTS",0)),5)
  1.  I D S LBE(9999999-$P(D,U,1))="CPT: "_$P(D,U,2)
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX02(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"02",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 02^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.1",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.1"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.19")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.19"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V80.3")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V80.3"
  1.  S D=$$LASTPRCI^APCHSMU2(P,"18.11")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 18.11"
  1.  S D=$$LASTCPTI^APCHSMU2(P,92700)
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: 92700"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX04(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"04",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 04^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V76.42",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V76.42"
  1.  S D=$$LASTPRCI^APCHSMU2(P,"89.31")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 89.31"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX06(P,BD,ED) ;
  1.  NEW Y
  1.  S Y=$$LASTBRST^APCLAPI3(P)
  1.  I $P(Y,U)<BD S Y=""
  1.  Q Y
  1.  ;
  1. LASTEX07(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"07",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 07^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.82",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.82"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX08(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"08",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 08^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.81",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.81"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V81.0")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V81.0"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V81.2")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V81.2"
  1.  S D=$$LASTCPTI^APCHSMU2(P,"G0367")
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: G0367"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX11(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"11",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 11^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V80.0",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V80.0"
  1.  S D=$$LASTPRCI^APCHSMU2(P,"89.13")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 89.13"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1. LASTEX12(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,"12",BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 12^"_$P(D,U,2,99)
  1.  S D=$$LASTPRCI^APCHSMU2(P,"89,39")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 89.39"
  1.  S D=$$LASTCPTI^APCHSMU2(P,95851)
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: 95851"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1. LASTEX14(P,BD,ED) ;
  1.  NEW Y
  1.  S Y=$$LASTRECT^APCLAPI2(P)
  1.  I $P(Y,U)<BD S Y=""
  1.  Q Y
  1.  ;
  1. LASTEX15(P,BD,ED) ;
  1.  NEW Y
  1.  S Y=$$LASTPELV^APCLAPI2(P)
  1.  I $P(Y,U)<BD S Y=""
  1.  Q Y
  1.  ;
  1. LASTEX16(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,16,BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 16^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V20.2",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V20.2"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V79.3",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V79.3"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX17(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,17,BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 17^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.11",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.11"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.19",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.19"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX19(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,19,BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 19^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.0",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.0"
  1.  S D=$$LASTPRCI^APCHSMU2(P,"95.09")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 95.09"
  1.  S D=$$LASTPRCI^APCHSMU2(P,"95.05")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 95.05"
  1.  S D=$$LASTCPTI^APCHSMU2(P,99172)
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: 99172"
  1.  S D=$$LASTCPTI^APCHSMU2(P,99173)
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: 99173"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX21(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,21,BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 21^"_$P(D,U,2,99)
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.1",BD,DT)
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.1"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V72.19")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V72.19"
  1.  S D=$$LASTDXI^APCHSMU2(P,"V80.3")
  1.  I D S LBE(9999999-$P(D,U,3))="Dx: V80.3"
  1.  S D=$$LASTPRCI^APCHSMU2(P,"18.11")
  1.  I D S LBE(9999999-$P(D,U,3))="ICD: 18.11"
  1.  S D=$$LASTCPTI^APCHSMU2(P,92700)
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: 92700"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEX23(P,BD,ED) ;
  1.  NEW LBE,D
  1.  K LBE
  1.  S ED=$G(ED)
  1.  S D=$$LASTEXAM(P,23,BD,ED)
  1.  I D]"" S LBE(9999999-$P(D,U,1))="Exam code 23^"_$P(D,U,2,99)
  1.  S D=$$LASTCPTI^APCHSMU2(P,92551)
  1.  I D S LBE(9999999-$P(D,U,3))="CPT: 92551"
  1.  I '$D(LBE) Q ""
  1.  S D=$O(LBE(0))
  1.  Q (9999999-D)_"^"_LBE(D)
  1.  ;
  1. LASTEXAM(P,C,B,E) ;
  1.  I '$G(P) Q ""
  1.  I $G(C)="" Q ""
  1.  S B=$G(B)
  1.  S E=$G(E)
  1.  NEW D,I
  1.  S C=$O(^AUTTEXAM("C",C,0))
  1.  I C="" Q ""
  1.  S D=$O(^AUPNVXAM("AA",P,C,0))
  1.  I D="" Q ""
  1.  I (9999999-D)<B Q ""  ;before date limits
  1.  S I=$O(^AUPNVXAM("AA",P,C,D,0))
  1.  Q (9999999-D)_"^"_$$VAL^XBDIQ1(9000010.13,I,.04)_"^"_$$VAL^XBDIQ1(9000010.13,I,1204)_"^"_$$VAL^XBDIQ1(9000010.13,I,81101)
  1.  ;
  1. RAD ; ******************* RAD TESTS - ALL * 9000010.12 *******
  1.  G RAD^BSDX41P