- 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