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