- BCHRP31 ; IHS/CMI/LAB - PROCESS REPORT ;
- ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- ;IHS/CMI/LAB - tmp to xtmp
- ;
- ;
- ;
- ;
- START ;
- D XTMP^BCHUTIL("BCHRP3","CHR ACTIVITY REPORT")
- S (BCHBT,BCHBTH)=$H,BCHJOB=$J
- D D,END
- Q
- ;
- D ; Run by date of service
- S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X
- S BCHODAT=BCHSD_".9999" F S BCHODAT=$O(^BCHR("B",BCHODAT)) Q:BCHODAT=""!((BCHODAT\1)>BCHED) D D1
- Q
- ;
- END ;
- S BCHET=$H
- D EOJ
- Q
- EOJ ;
- Q
- D1 ;
- S (BCHR,BCHRCNT)=0 F S BCHR=$O(^BCHR("B",BCHODAT,BCHR)) Q:BCHR'=+BCHR I $D(^BCHR(BCHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"",$D(^BCHRPROB("AD",BCHR)) S BCHR0=^BCHR(BCHR,0) D PROC
- Q
- PROC ;
- S BCHPAT=$P(BCHR0,U,4)
- S BCHNRPAT=$P($G(^BCHR(BCHR,11)),U,12)
- ;I 'BCHPAT,'BCHNRPAT Q ;no patient
- I BCHREG="R",BCHPAT="" Q
- I BCHREG="N",BCHNRPAT="" Q
- I BCHPAT,BCHNRPAT S BCHNRPAT=""
- I BCHPAT Q:'$D(^DPT(BCHPAT,0))
- S BCHPROG=$P(BCHR0,U,2),BCHPROGN=$P(^BCHTPROG(BCHPROG,0),U)_" ("_$P(^(0),U,5)_")"
- I BCHPRG,BCHPRG'=BCHPROG Q ;not correct program
- S BCHLOC=$P(BCHR0,U,6) Q:BCHLOC="" S BCHLOCN=$P(^BCHTACTL(BCHLOC,0),U)
- S BCHPROV=$P(BCHR0,U,3) Q:BCHPROV="" S BCHPNAME=$P(^VA(200,BCHPROV,0),U)
- S BCHX=0 F S BCHX=$O(^BCHRPROB("AD",BCHR,BCHX)) Q:BCHX'=+BCHX S BCHACT=$P(^BCHRPROB(BCHX,0),U,4),BCHPROB=$P(^(0),U) I BCHACT]"" D
- .S BCHACTN=$P(^BCHTSERV(BCHACT,0),U)_" ("_$P(^(0),U,3)_")"
- .S BCHPROB=$P(^BCHTPROB(BCHPROB,0),U)_" ("_$P(^(0),U,2)_")"
- .S $P(^(BCHPROB),U)=$S($D(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROGN,BCHLOCN,BCHPNAME,BCHACTN,BCHPROB)):$P(^(BCHPROB),U)+1,1:1)
- .S $P(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROGN,BCHLOCN,BCHPNAME,BCHACTN,BCHPROB),U,2)=$P(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROGN,BCHLOCN,BCHPNAME,BCHACTN,BCHPROB),U,2)+$P(^BCHRPROB(BCHX,0),U,5)
- Q
- BCHRP31 ; 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 ;
- +5 ;
- +6 ;
- START ;
- +1 DO XTMP^BCHUTIL("BCHRP3","CHR ACTIVITY REPORT")
- +2 SET (BCHBT,BCHBTH)=$HOROLOG
- SET BCHJOB=$JOB
- +3 DO D
- DO END
- +4 QUIT
- +5 ;
- D ; Run by date of service
- +1 SET X1=BCHBD
- SET X2=-1
- DO C^%DTC
- SET BCHSD=X
- +2 SET BCHODAT=BCHSD_".9999"
- FOR
- SET BCHODAT=$ORDER(^BCHR("B",BCHODAT))
- IF BCHODAT=""!((BCHODAT\1)>BCHED)
- QUIT
- DO D1
- +3 QUIT
- +4 ;
- END ;
- +1 SET BCHET=$HOROLOG
- +2 DO EOJ
- +3 QUIT
- EOJ ;
- +1 QUIT
- D1 ;
- +1 SET (BCHR,BCHRCNT)=0
- FOR
- SET BCHR=$ORDER(^BCHR("B",BCHODAT,BCHR))
- IF BCHR'=+BCHR
- QUIT
- IF $DATA(^BCHR(BCHR,0))
- IF $PIECE(^(0),U,2)]""
- IF $PIECE(^(0),U,3)]""
- IF $DATA(^BCHRPROB("AD",BCHR))
- SET BCHR0=^BCHR(BCHR,0)
- DO PROC
- +2 QUIT
- PROC ;
- +1 SET BCHPAT=$PIECE(BCHR0,U,4)
- +2 SET BCHNRPAT=$PIECE($GET(^BCHR(BCHR,11)),U,12)
- +3 ;I 'BCHPAT,'BCHNRPAT Q ;no patient
- +4 IF BCHREG="R"
- IF BCHPAT=""
- QUIT
- +5 IF BCHREG="N"
- IF BCHNRPAT=""
- QUIT
- +6 IF BCHPAT
- IF BCHNRPAT
- SET BCHNRPAT=""
- +7 IF BCHPAT
- IF '$DATA(^DPT(BCHPAT,0))
- QUIT
- +8 SET BCHPROG=$PIECE(BCHR0,U,2)
- SET BCHPROGN=$PIECE(^BCHTPROG(BCHPROG,0),U)_" ("_$PIECE(^(0),U,5)_")"
- +9 ;not correct program
- IF BCHPRG
- IF BCHPRG'=BCHPROG
- QUIT
- +10 SET BCHLOC=$PIECE(BCHR0,U,6)
- IF BCHLOC=""
- QUIT
- SET BCHLOCN=$PIECE(^BCHTACTL(BCHLOC,0),U)
- +11 SET BCHPROV=$PIECE(BCHR0,U,3)
- IF BCHPROV=""
- QUIT
- SET BCHPNAME=$PIECE(^VA(200,BCHPROV,0),U)
- +12 SET BCHX=0
- FOR
- SET BCHX=$ORDER(^BCHRPROB("AD",BCHR,BCHX))
- IF BCHX'=+BCHX
- QUIT
- SET BCHACT=$PIECE(^BCHRPROB(BCHX,0),U,4)
- SET BCHPROB=$PIECE(^(0),U)
- IF BCHACT]""
- Begin DoDot:1
- +13 SET BCHACTN=$PIECE(^BCHTSERV(BCHACT,0),U)_" ("_$PIECE(^(0),U,3)_")"
- +14 SET BCHPROB=$PIECE(^BCHTPROB(BCHPROB,0),U)_" ("_$PIECE(^(0),U,2)_")"
- +15 SET $PIECE(^(BCHPROB),U)=$SELECT($DATA(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROGN,BCHLOCN,BCHPNAME,BCHACTN,BCHPROB)):$PIECE(^(BCHPROB),U)+1,1:1)
- +16 SET $PIECE(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROGN,BCHLOCN,BCHPNAME,BCHACTN,BCHPROB),U,2)=$PIECE(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROGN,BCHLOCN,BCHPNAME,BCHACTN,BCHPROB),U,2)+$PIECE(^BCHRPROB(BCHX,0),U,5)
- End DoDot:1
- +17 QUIT
