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

BCHRPTST.m

Go to the documentation of this file.
  1. BCHRPTST ; IHS/CMI/LAB - PROCESS REPORT ;
  1. ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1. ;IHS/CMI/LAB - tmp to xtmp
  1. ;
  1. ;IHS/CMI/LAB - patch 9 fixed naked reference
  1. SETTMP2 ;EP ; set tmp for top ten record reports
  1. UTL ;
  1. I BCHRPROC="ACT"!(BCHRPROC="ACTC")!(BCHRPROC="PROB")!(BCHRPROC="PROBCAT") D MULT10 Q
  1. D @BCHRPROC
  1. S X=BCHA
  1. S BCHPOV=@BCHSORT
  1. I '$D(@X) S @X=0
  1. S %=+(@X),%=%+1,%1=$P((@X),U,3),%1=%1+$P(BCHR0,U,27),@X=%_"^"_BCHSRT2_"^"_%1
  1. Q
  1. ;
  1. SET F BCHPOV=0:0 S BCHPOV=$O(@BCHA) Q:'BCHPOV S %=^(BCHPOV),@BCHC@(9999999-%,BCHPOV)="" ;global reference in BCHA is ^XTMP("BCHTEN",BCHJOB,BCHBT,"POV",BCHPOV)
  1. Q
  1. SETTMP ;EP - CALLED FROM BCHPT4
  1. I BCHRPROC="ACT"!(BCHRPROC="ACTC")!(BCHRPROC="PROB")!(BCHRPROC="PROBCAT") D MULT Q
  1. D @BCHRPROC
  1. S ^(BCHSRT2)=$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",@BCHSORT,BCHSRT2)):^(BCHSRT2)+1,1:1)
  1. S ^(BCHSRT2)=$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",@BCHSORT,BCHSRT2)):^(BCHSRT2)+$P(BCHR0,U,12),1:$P(BCHR0,U,12))
  1. S ^(BCHSRT2)=$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",@BCHSORT,BCHSRT2)):^(BCHSRT2)+$P(BCHR0,U,27),1:$P(BCHR0,U,27))
  1. Q
  1. PROG ;
  1. S BCHPROG=$P(BCHR0,U,2) I BCHPROG="" S BCHPROG="NO PROGRAM ENTERED",BCHSRT2="--" Q
  1. S BCHSRT2=$P(^BCHTPROG(BCHPROG,0),U,5),BCHPROG=$P(^BCHTPROG(BCHPROG,0),U)
  1. Q
  1. ;
  1. DATE ;
  1. S BCHDATE=$P(BCHODAT,".")
  1. S X=BCHDATE D H^%DTC S BCHSRT2=$P("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1) I BCHSRT2="" S BCHSRT2="UNKNOWN"
  1. Q
  1. PROV ;
  1. S BCHPROV=$$PPNAME^BCHUTIL(BCHR),BCHSRT2=$E($$PPCLS^BCHUTIL(BCHR,"E"),1,20)
  1. Q
  1. COMM ;
  1. S BCHCOMM=$P($G(^BCHR(BCHR,11)),U,6) I BCHCOMM="" S BCHCOMM="NOT AVAILABLE",BCHSRT2="-------" Q
  1. S BCHSRT2=$P(^AUTTCOM(BCHCOMM,0),U,8),BCHCOMM=$P(^(0),U)
  1. Q
  1. ACT ;
  1. S BCHACT=$P(^BCHRPROB(BCHPPOV,0),U,4)
  1. S BCHSRT2=$S(BCHACT:$P(^BCHTSERV(BCHACT,0),U,3),1:"??"),BCHACT=$S(BCHACT:$P(^BCHTSERV(BCHACT,0),U),1:"<missing>")
  1. Q
  1. SU ;
  1. S BCHSU=$P(^AUTTLOC($P(BCHR0,U,4),0),U,5) I BCHSU="" S BCHSU="NONE ENTERED",BCHSRT2="9999" Q
  1. S BCHSRT2=$P(^AUTTSU(BCHSU,0),U,4),BCHSU=$P(^AUTTSU(BCHSU,0),U)
  1. LOS ;
  1. S BCHVLOC=$P(BCHR0,U,6) I BCHVLOC="" S BCHSRT2="--",BCHVLOC="NONE ENTERED" Q
  1. S BCHSRT2=$P(^BCHTACTL(BCHVLOC,0),U,5),BCHVLOC=$P(^(0),U)
  1. Q
  1. ;
  1. PROB ;
  1. S BCHPROB=$P(^BCHRPROB(BCHPPOV,0),U),BCHSRT2=$P(^BCHTPROB(BCHPROB,0),U,2),BCHPROB=$P(^BCHTPROB(BCHPROB,0),U)
  1. Q
  1. PROBCAT ;
  1. S BCHSRT2=$P(^BCHTPROB($P(^BCHRPROB(BCHPPOV,0),U),0),U,3),(BCHSRT2,BCHPROB)=$P(^BCHTHAC(BCHSRT2,0),U)
  1. Q
  1. MULT ;
  1. S BCHPPOV=$O(^BCHRPROB("AD",BCHR,""))
  1. I BCHPPOV="" S BCHPROB="NO POVS ENTERED",BCHSRT2="-----" Q
  1. S BCHPPOV=0 F S BCHPPOV=$O(^BCHRPROB("AD",BCHR,BCHPPOV)) Q:BCHPPOV'=+BCHPPOV D
  1. .D @BCHRPROC
  1. .S ^(BCHSRT2)=$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",@BCHSORT,BCHSRT2)):^(BCHSRT2)+1,1:1)
  1. .S ^(BCHSRT2)=$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",@BCHSORT,BCHSRT2)):^(BCHSRT2)+$P(BCHR0,U,12),1:$P(BCHR0,U,12))
  1. .I $D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",@BCHSORT,BCHSRT2)) S ^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",@BCHSORT,BCHSRT2)=^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",@BCHSORT,BCHSRT2)+$P(^BCHRPROB(BCHPPOV,0),U,5)
  1. .I '$D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",@BCHSORT,BCHSRT2)) S ^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",@BCHSORT,BCHSRT2)=$P(^BCHRPROB(BCHPPOV,0),U,5)
  1. Q
  1. MULT10 ;
  1. S BCHPPOV=$O(^BCHRPROB("AD",BCHR,""))
  1. I BCHPPOV="" S (BCHPROB,BCHACT)="NO POVS ENTERED",BCHSRT2="-----" Q
  1. S BCHPPOV=0 F S BCHPPOV=$O(^BCHRPROB("AD",BCHR,BCHPPOV)) Q:BCHPPOV'=+BCHPPOV D
  1. .D @BCHRPROC
  1. .S X=BCHA
  1. .S BCHPOV=@BCHSORT
  1. .I '$D(@X) S @X=0
  1. .S %=+(@X),%=%+1,%1=$P((@X),U,3),%1=%1+$P(^BCHRPROB(BCHPPOV,0),U,5),@X=%_"^"_BCHSRT2_"^"_%1
  1. .Q
  1. Q