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

BSDX41J.m

Go to the documentation of this file. 
  1. BSDX41J ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
  1.  ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
  1.  ;
  1. MRL ; ******************** MOST RECENT LAB * 9000010.09 *******
  1.  I '$D(^AUPNVLAB("AA",APCHSPAT)) D EKGLAB G MRLX
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  ;X:'APCHSNPG APCHSBRK
  1.  ; <SETUP>
  1.  ; <PROCESS>
  1.  D LBLD,LPRT
  1.  D EKGLAB
  1.  ;now display lab refusals
  1.  S APCHST="LAB",APCHSFN=60 D DISPREF^BSDX41F
  1.  K APCHST,APCHSFN
  1.  ; <CLEANUP>
  1. MRLX K APCHSLT,APCHSLR,APCHSLTX,APCHSLRT,APCHSLL,APCHSLW,APCHSNMX,APCHSDFN,APCHSIVD,APCHSLTD,APCHSN,Y
  1.  K ^TMP($J,"APCHS"),^TMP($J,"APCHS1")
  1.  Q
  1.  ; <BUILD>
  1. LBLD K ^TMP($J,"APCHS","LAB"),^TMP($J,"APCHS1")
  1.  S APCHSLRT="" F APCHSQ=0:0 S APCHSLRT=$O(^AUPNVLAB("AA",APCHSPAT,APCHSLRT)) Q:APCHSLRT=""  D LDATE
  1.  D REORDER
  1.  Q
  1. REORDER ;reorder by accession, parent and child
  1.  S X=0 F  S X=$O(^TMP($J,"APCHS","LAB",X)) Q:X'=+X  D
  1.  .S Y=$P(^TMP($J,"APCHS","LAB",X),U,3)
  1.  .S %=$E($P(^AUPNVLAB(Y,0),U,6),1,2) S:%="" %="ZZ"
  1.  .S %1=$S($P($G(^AUPNVLAB(Y,12)),U,8)]"":$P(^AUPNVLAB(Y,12),U,8),1:Y)
  1.  .S %2=$S($P($G(^AUPNVLAB(Y,12)),U,8)="":0,1:Y)
  1.  .S ^TMP($J,"APCHS1",%,%1,%2,X)=^TMP($J,"APCHS","LAB",X)
  1.  .Q
  1.  K ^TMP($J,"APCHS")
  1.  Q
  1. LDATE S APCHSIVD=$O(^AUPNVLAB("AA",APCHSPAT,APCHSLRT,0))
  1.  S APCHSDFN=0 F  S APCHSDFN=$O(^AUPNVLAB("AA",APCHSPAT,APCHSLRT,APCHSIVD,APCHSDFN)) Q:APCHSDFN'=+APCHSDFN   D:APCHSIVD&(APCHSIVD'>APCHSDLM) LSET
  1.  Q
  1. LSET ;
  1.  S APCHSN=^AUPNVLAB(APCHSDFN,0),APCHSLR=$P(APCHSN,U,4)
  1.  I $P($G(^AUPNVLAB(APCHSDFN,11)),U,9)="R",APCHSLR="",$$VALI^XBDIQ1(60,$P(APCHSN,U),999999901) Q  ;do not display tests that are resulted, result is null and flag says don't display
  1.  I APCHSLR]"",APCHSLR'=" ",$P(APCHSN,U,5)]"" S APCHSLR=APCHSLR_" ("_$P(APCHSN,U,5)_")"
  1.  I APCHSLR="",$P($G(^TMP($J,"APCHS","LAB",APCHSLRT)),U,2)]"" Q
  1.  S ^TMP($J,"APCHS","LAB",APCHSLRT)=(-APCHSIVD\1+9999999)_U_APCHSLR_U_APCHSDFN S APCHSLTX=$P(^LAB(60,APCHSLRT,0),U,1)
  1.  Q
  1.  ; <PRINT>
  1. LPRT ;
  1.  S BSDXTMP=" "_"TEST"
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(22-$L(BSDXTMP))_"RESULT DT/TIME"
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(38-$L(BSDXTMP))_"VISIT"
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(46-$L(BSDXTMP))_"RESULT"
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(59-$L(BSDXTMP))_"UNITS"
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(69-$L(BSDXTMP))_"REF RANGE"
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXTMP=""
  1.  S APCHSACC="" F  S APCHSACC=$O(^TMP($J,"APCHS1",APCHSACC)) Q:APCHSACC=""!($D(APCHSQIT))  D
  1.  .S APCHSPAR=0 F  S APCHSPAR=$O(^TMP($J,"APCHS1",APCHSACC,APCHSPAR)) Q:APCHSPAR'=+APCHSPAR!($D(APCHSQIT))  D
  1.  ..S APCHCHIL="" F  S APCHCHIL=$O(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL)) Q:APCHCHIL=""  D
  1.  ...S APCHSLT=$O(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,0))
  1.  ...S APCHSDFN=$P(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,3)
  1.  ...S Y=$P(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,1),APCHSLR=$P(^TMP($J,"APCHS1",APCHSACC,APCHSPAR,APCHCHIL,APCHSLT),U,2) X APCHSCVD S APCHSLTD=Y
  1.  ...D LPRT2
  1.  K APCHCHIL,APCHSPAR,APCHSACC,APCHSLT
  1.  Q
  1. LPRT2 ;
  1.  S APCHSLTX=$P(^LAB(60,APCHSLT,0),U)
  1.  S APCHSRDT=$P($G(^AUPNVLAB(APCHSDFN,12)),U,12) I APCHSRDT]"" S APCHSRDT=$$DATE^APCHSMU($P(APCHSRDT,"."))_"@"_$P($P($$FMTE^XLFDT(APCHSRDT),"@",2),":",1,2)
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  I APCHSNPG D
  1.  .S BSDXTMP=" "_"TEST"
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(22-$L(BSDXTMP))_"RESULT DT/TIME"
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(38-$L(BSDXTMP))_"VISIT"
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(46-$L(BSDXTMP))_"RESULT"
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(59-$L(BSDXTMP))_"UNITS"
  1.  .S BSDXTMP=BSDXTMP_$$FILL^BSDX41(69-$L(BSDXTMP))_"REF RANGE"
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXTMP=""
  1.  S:APCHCHIL BSDXTMP=" "
  1.  S BSDXTMP=BSDXTMP_$E(APCHSLTX,1,20)
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(22-$L(BSDXTMP))_APCHSRDT
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(37-$L(BSDXTMP))_APCHSLTD
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(46-$L(BSDXTMP))_APCHSLR
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(59-$L(BSDXTMP))_$P($G(^AUPNVLAB(APCHSDFN,11)),U)
  1.  I $P($G(^AUPNVLAB(APCHSDFN,11)),U,4)]""!($P($G(^AUPNVLAB(APCHSDFN,11)),U,5)]"") S BSDXTMP=BSDXTMP_$$FILL^BSDX41(69-$L(BSDXTMP))_$P(^AUPNVLAB(APCHSDFN,11),U,4)_"-"_$P(^AUPNVLAB(APCHSDFN,11),U,5)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  I '$P(^APCHSCTL(APCHSTYP,0),U,7) Q
  1.  ;print out comments per Dorothy
  1.  S APCHSX=0 F  S APCHSX=$O(^AUPNVLAB(APCHSDFN,21,APCHSX)) Q:APCHSX'=+APCHSX!($D(APCHSQIT))  D
  1.  .;X APCHSCKP Q:$D(APCHSQIT)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=^AUPNVLAB(APCHSDFN,21,APCHSX,0)_$C(30)
  1.  F APCHSX=1:1:3 Q:$D(APCHSQIT)  I $P($G(^AUPNVLAB(APCHSDFN,13)),U,APCHSX)]"" D
  1.  .;X APCHSCKP Q:$D(APCHSQIT)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$P(^AUPNVLAB(APCHSDFN,13),U,APCHSX)_$C(30)
  1.  Q
  1.  ;
  1. EKGLAB ;ENTRY POINT - EKG display in most recent lab panel
  1.  Q:'$D(^AUPNVDXP("AC",APCHSPAT))
  1.  K APCHS
  1.  S APCHSERR=$$START1^APCLDF(APCHSPAT_"^LAST DIAGNOSTIC ECG SUMMARY","APCHS(")
  1.  G:APCHSERR EKGLABX
  1.  ; *array APCHS(1)="DATE^RESULT^DIAG PROC^VDIAG PROCEDURE IEN^AUPNVDXP^VISIT IEN"
  1.  K APCHSERR
  1.  S APCHSIVD=$S($D(APCHS(1)):9999999-$P($P(APCHS(1),U,1),".",1),1:"")
  1.  Q:'APCHSIVD!(APCHSIVD>APCHSDLM)
  1.  S (APCHSLTX,APCHSLT)="EKG"
  1.  S APCHSLRT("EKG")=$P(APCHS(1),U,1)_"^"_$P(APCHS(1),U,2)
  1.  D EKGPRT  ;                           computes/prints ekg info
  1. EKGLABX ;
  1.  K APCHSERR,APCHS(1)
  1.  Q
  1.  ;
  1. EKGPRT ;computers/prints ekg info
  1.  S Y=$P(APCHSLRT(APCHSLT),U,1) X APCHSCVD S APCHSLTD=Y
  1.  S APCHSLR=$P(APCHSLRT(APCHSLT),U,2)
  1.  S APCHSLR=$S(APCHSLR="N":"NORMAL",APCHSLR="A":"ABNORMAL",APCHSLR="B":"BORDERLINE",1:"<none recorded>") ;IHS/CMI/LAB added borderline
  1.  S APCHSLW=$S($G(APCHSLW):APCHSLW,1:28)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=APCHSLTX_$$FILL^BSDX41(APCHSLW-$L(APCHSLTX))_APCHSLTD_"  "_APCHSLR_$C(30)
  1.  Q
  1.  ;
  1. MCIS ; *********** MANAGED CARE MIS * 90001
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  NEW X
  1.  S X="BMCHS" X ^%ZOSF("TEST") I $T G HS ; write mcis summary
  1.  G:'$D(^BMCREF("D",APCHSPAT)) MCISX ; exit if no referrals for patient
  1.  ;X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="<MCIS DISPLAY ROUTINE MISSING!>"_$C(30)
  1. MCISX ;MCIS EXIT
  1.  ;
  1. HS ;EP-called from health summary
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$$CTR^BMC(" <<<  RCIS ACTIVE REFERRALS  >>> ",80)_$C(30)
  1.  I '$D(^BMCREF("AA",APCHSPAT)) D  Q
  1.  .;X APCHSCKP Q:$D(APCHSQIT)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="No Referred Care Referral records on file."_$C(30)
  1.  .Q
  1.  S X1=DT,X2=-365 D C^%DTC S BMCYAGO=X ;      date one year ago
  1.  I $O(^BMCREF("AA",APCHSPAT,""),-1)<BMCYAGO D  Q
  1.  .;X APCHSCKP Q:$D(APCHSQIT)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  .S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="No Referred Care Referral records within last year."_$C(30)
  1.  .Q
  1.  S BMCRDATE=""
  1.  F  S BMCRDATE=$O(^BMCREF("AA",APCHSPAT,BMCRDATE),-1) Q:BMCRDATE<BMCYAGO!($D(APCHSQIT))  S BMCRIEN=0 F  S BMCRIEN=$O(^BMCREF("AA",APCHSPAT,BMCRDATE,BMCRIEN)) Q:'BMCRIEN!($D(APCHSQIT))  D WRTREF
  1. XIT ;
  1.  K DIEN,BMCPFH,BMCPFS,BMCPIEN,BMCYAGO,BMCCHSCT,BMCDFN,BMCRDATE,BMCREC,BMCRIEN,BMCRIO,BMCRNUMB,BMCRREC,BMCRSTAT,BMCRTYPE,BMCX,BMCDIEN
  1.  Q
  1.  ;
  1. WRTREF ; WRITE RCIS REFERRAL ENTRY
  1.  S BMCRREC=^BMCREF(BMCRIEN,0)
  1.  S Y=BMCRIEN
  1.  D ^BMCREF
  1.  ;
  1.  Q:BMCRSTAT'="A"  ;Quit if Not an Active Referral
  1.  ;
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(30)
  1.  S BSDXTMP="BEGIN DOS: "_$$AVDOS^BMCRLU(BMCRIEN,"C")_"  "_$$AVDOS^BMCRLU(BMCRIEN,"E")
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(36-$L(BSDXTMP))_"DISCHARGE CONSULT DT: "_$$FMTE^XLFDT($P(BMCRREC,U,18),"5D")
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$C(30)
  1.  S BSDXTMP=""
  1.  S BSDXTMP="DATE REFERRED: "_$$FMTE^XLFDT($P(BMCRREC,U),"5D")
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$$FILL^BSDX41(36-$L(BSDXTMP))_"CHS STATUS: "_$$VAL^XBDIQ1(90001,BMCRIEN,1112)_$C(30)
  1.  S BSDXTMP=""
  1.  S BMCMCC=""
  1.  I $D(^BMCPARM(DUZ(2),4100)) S BMCMCC=$P($G(^BMCPARM(DUZ(2),4100)),U)
  1.  I BMCMCC="Y" S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$$FILL^BSDX41(36)_"MCC ACTION: "_$$VAL^XBDIQ1(90001,BMCRIEN,1123)_$C(30)
  1.  S BSDXTMP="REFERRED BY: "_$S($P(BMCRREC,U,6):$E($P(^VA(200,$P(BMCRREC,U,6),0),U),1,22),1:"???")
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$$FILL^BSDX41(36-$L(BSDXTMP))_"REFERRED TO: "_$$TOFAC^BMC(BMCRIEN)_$C(30)
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="PURPOSE: "_$$VAL^XBDIQ1(90001,BMCRIEN,1201)_$C(30)
  1.  D WRTDXPX
  1.  Q
  1.  ;
  1. WRTDXPX ; WRITE DX's and PX's
  1.  D WRTDX
  1.  Q:$D(APCHSQIT)
  1.  D WRTPX
  1.  Q
  1.  ;
  1. WRTDX ; WRITE DX'S FOR THIS REFERRAL
  1.  I '$O(^BMCDX("AD",BMCRIEN,0)) D WRTCATD Q  ; no dx's so write category
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="DIAGNOSES"_$C(30)
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S BMCPFS="F"
  1.  D WRTDXLP ;                                          write finals
  1.  I BMCRSTAT="A"!('BMCPFH) S BMCPFS="P" D WRTDXLP ;    write provisionals
  1.  Q
  1.  ;
  1. WRTDXLP ; LOOP THRU DX ENTRIES
  1.  S (BMCDIEN,BMCPFH)=0
  1.  F  S BMCDIEN=$O(^BMCDX("AD",BMCRIEN,BMCDIEN)) Q:'BMCDIEN  D WRTDX2 Q:$D(APCHSQIT)
  1.  Q
  1.  ;
  1. WRTDX2 ; WRITE ONE DX
  1.  S X=^BMCDX(BMCDIEN,0)
  1.  Q:$P(X,U,4)'=BMCPFS
  1.  S BSDXTMP=$$FILL^BSDX41(9)_$P(^ICD9($P(X,U),0),U)
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(18-$L(BSDXTMP))_$S($P(X,U,4)="P":"PROV",$P(X,U,4)="F":"FINAL",1:"???")_" "_$S($P(X,U,5)="P":"PRI",$P(X,U,5)="S":"SEC",1:"???")
  1.  S X=$P(X,U,6)
  1.  I X S:$D(^AUTNPOV(X,0)) X=$P(^AUTNPOV(X,0),U) I 1
  1.  E  D ENP^XBDIQ1(90001.01,BMCDIEN,".019","BMCX(","E") S:BMCX(".019")]"" X=BMCX(".019")
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$$FILL^BSDX41(26-$L(BSDXTMP))_X_$C(30)
  1.  S BSDXTMP=""
  1.  S BMCPFH=1
  1.  ;X APCHSCKP
  1.  Q
  1.  ;
  1. WRTPX ; WRITE PX'S FOR THIS REFERRAL
  1.  I '$O(^BMCPX("AD",BMCRIEN,0)) D WRTCATS Q  ; no px's so write category
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="PROCEDURES"_$C(30)
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  S BMCPFS="F"
  1.  D WRTPXLP ;                                         write finals
  1.  I BMCRSTAT="A"!('BMCPFH) S BMCPFS="P" D WRTPXLP ;   write provisionals
  1.  Q
  1.  ;
  1. WRTPXLP ; LOOP THRU PX ENTRIES
  1.  S (BMCPIEN,BMCPFH)=0
  1.  F  S BMCPIEN=$O(^BMCPX("AD",BMCRIEN,BMCPIEN)) Q:'BMCPIEN  D WRTPX2 Q:$D(APCHSQIT)
  1.  Q
  1.  ;
  1. WRTPX2 ; WRITE ONE PX
  1.  S X=^BMCPX(BMCPIEN,0)
  1.  Q:$P(X,U,4)'=BMCPFS
  1.  S BSDXTMP=$$FILL^BSDX41(9)_$S($P(X,U)'=1:$P(^ICPT($P(X,U),0),U),1:"???")
  1.  S BSDXTMP=BSDXTMP_$$FILL^BSDX41(17-$L(BSDXTMP))_$S($P(X,U,4)="P":"PROV",$P(X,U,4)="F":"FINAL",1:"???")_" "_$S($P(X,U,5)="P":"PRI",$P(X,U,5)="S":"SEC",1:"???")
  1.  S X=$P(X,U,6)
  1.  I X S:$D(^AUTNPOV(X,0)) X=$P(^AUTNPOV(X,0),U) I 1
  1.  E  D ENP^XBDIQ1(90001.02,BMCPIEN,".019","BMCX(","E") S:BMCX(".019")]"" X=BMCX(".019")
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$$FILL^BSDX41(26-$L(BSDXTMP))_X_$C(30)
  1.  S BSDXTMP=""
  1.  S BMCPFH=1
  1.  ;X APCHSCKP
  1.  Q
  1.  ;
  1. WRTCAT ; WRITE DX/SVC CAT
  1.  D WRTCATD
  1.  D WRTCATS
  1.  Q
  1.  ;
  1. WRTCATD ; WRITE DX CAT
  1.  D ENP^XBDIQ1(90001,BMCRIEN,".12","BMCX(","E") S X=BMCX(".12")
  1.  S BSDXTMP="DIAGNOSTIC CATEGORY:"
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$$FILL^BSDX41(24-$L(BSDXTMP))_X_$C(30)
  1.  S BSDXTMP=""
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  Q
  1.  ;
  1. WRTCATS ; WRITE PX CAT
  1.  Q  ;Remove from HS per Dr. Griffith 11-23-00
  1.  D ENP^XBDIQ1(90001,BMCRIEN,".13","BMCX(","E") S X=BMCX(".13")
  1.  S BSDXTMP="CPT SERVICE CATEGORY:"
  1.  S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=BSDXTMP_$$FILL^BSDX41(24-$L(BSDXTMP))_X_$C(30)
  1.  S BSDXTMP=""
  1.  ;X APCHSCKP Q:$D(APCHSQIT)
  1.  Q