BPCPC ; IHS/OIT/MJL - PATIENT CHART RELATED ROUTINES FOR GUI ;
;;1.5;BPC;;MAY 26, 2005
BPCCHT(RESULT,BPCIEN,BPCOPT,BPCLIM,BPCSDATE,BPCEDATE) ;EP CALL FROM REMOTE PROC: BPC CHARTDATA
;
;POSSIBLE OPTIONS (BPCOPT)
;1 - RETURN CHOSEN NUMBER OF VISITS (BPCLIM) WITHIN DATE RANGE
;2 - RETURN ALL VISITS WITHIN DATE RANGE
;3 - RETURN LAB VISITS ONLY WITHIN DATE RANGE
EN ;
S U="^",XWBWRAP=1,BPCLIM=$G(BPCLIM,10),BPCSUB=$J,BPCMFLG="" K ^BGUTMP(BPCSUB),^BGURES(BPCSUB),RESULT
S:'BPCLIM BPCLIM=10
S RESULT="^BGURES("_BPCSUB_")"
;I '$D(BPCIEN) S RESULT(1)=-1,RESULT(2)="NO PATIENT IEN SENT!" Q
I '$D(BPCIEN) S ^BGURES(BPCSUB,1)=-1,^BGURES(BPCSUB,2)="NO PATIENT IEN SENT!" Q
S BPCOPT=$G(BPCOPT,1),BPCSDATE=$G(BPCSDATE),BPCEDATE=$G(BPCEDATE)
S:BPCOPT=2 BPCLIM=9999999
I BPCSDATE'="" S BPCFLG=0 D GETDATES I BPCFLG D KILL Q
D VISIT,SETRES,KILL
Q
GETDATES ;
D DT^DILF("",BPCSDATE,.BPCSDAT)
;I BPCSDAT=-1 S RESULT(1)=-1,RESULT(2)="INVALID START DATE!",BPCFLG=1 Q
I BPCSDAT=-1 S ^BGURES(BPCSUB,1)=-1,^BGURES(BPCSUB,2)="INVALID START DATE!",BPCFLG=1 Q
I BPCEDATE="" S BPCEDATE="T"
D DT^DILF("",BPCEDATE,.BPCEDAT)
;I BPCEDAT=-1 S RESULT(1)=-1,RESULT(2)="INVALID END DATE!",BPCFLG=1
I BPCEDAT=-1 S ^BGURES(BPCSUB,1)=-1,^BGURES(BPCSUB,2)="INVALID END DATE!",BPCFLG=1
Q
KILL ;
K ^BGUTMP(BPCSUB)
K BPCPRV,BPCCDT,BPCCLIN,BPCCN,BPCCTR,BPCDAYS,BPCDDAY,BPCDNAM,BPCDTA,BPCEDATE,BPCFATH,BPCFLAGL,BPCFLG,BPCIEN,BPCLIM,BPCLOC,BPCMED
K BPCMOTH1,BPCMOTH2,BPCNAR,BPCOPT,BPCPDTA,BPCPOV,BPCQTY,BPCREFH,BPCREFL,BPCSC,BPCSDATE,BPCSIG,BPCSITE,BPCSUB,BPCTEST,BPCTEST1,BPCUNITS,BPCVALUE
K BPCVDT,BPCVSIT,BPCX,BPCX1,BPCY,BPCY11,BPCY12,BPCZ,BPCCKDT,BPCSDAT,BPCEDAT,BPCDD,BPCF
Q
VISIT ;
S BPCX=0,BPCCN=0,BPCCTR=0 F S BPCX=$O(^AUPNVSIT("AA",BPCIEN,BPCX)) Q:BPCX="" S BPCVSIT="" D Q:BPCCN=BPCLIM
.F S BPCVSIT=$O(^AUPNVSIT("AA",BPCIEN,BPCX,BPCVSIT)) Q:BPCVSIT="" D VISIT1 Q:BPCCN=BPCLIM
Q
VISIT1 ;
S BPCMFLG=$S($D(^AUPNVMIC("AD",BPCVSIT)):"B",1:"")
I BPCOPT=3,'$D(^AUPNVLAB("AD",BPCVSIT)) Q ;IF OPTION=LABS ONLY
S BPCY=^AUPNVSIT(BPCVSIT,0),BPCVDT=$P(BPCY,U,1),BPCLOC=$P(BPCY,U,6),BPCSC=$P(BPCY,U,7),BPCCLIN=$P(BPCY,U,8),BPCCKDT=$P(BPCVDT,".",1)
I BPCSDATE'="",BPCEDATE'="",((BPCCKDT<BPCSDAT)!(BPCCKDT>BPCEDAT)) Q ;IF NOT IN DATE RANGE
I $L(BPCLOC) S BPCLOC=$G(^AUTTLOC(BPCLOC,0)) S:$L(BPCLOC) BPCLOC=$P(BPCLOC,U,2)
I $L(BPCCLIN) S BPCCLIN=$G(^DIC(40.7,BPCCLIN,0)) S:$L(BPCCLIN) BPCCLIN=$P(BPCCLIN,U,1)
S BPCX1=0 F S BPCX1=$O(^AUPNVPRV("AD",BPCVSIT,BPCX1)) Q:BPCX1="" D PROV
S BPCCN=BPCCN+1,^BGUTMP(BPCSUB,BPCX,"VISIT","NONE",BPCCN)=BPCVDT_U_"VISIT"_U_BPCVSIT_U_BPCLOC_U_BPCSC_U_$G(BPCPRV)_U_BPCCLIN
D LAB,POV,MEAS
S BPCFLG="" S:$D(^BGUTMP(BPCSUB,BPCX,"LAB")) BPCFLG="L" S:$D(^BGUTMP(BPCSUB,BPCX,"POV")) BPCFLG=BPCFLG_"P"
S BPCF=0
D MED I BPCF S BPCFLG=BPCFLG_"M"
;S:$D(^BGUTMP(BPCSUB,BPCX,"MED")) BPCFLG=BPCFLG_"M"
;S $P(^BGUTMP(BPCSUB,BPCX,"VISIT","NONE"),U,6)=BPCFLG
S BPCFLG=BPCFLG_BPCMFLG,$P(^BGUTMP(BPCSUB,BPCX,"VISIT","NONE",BPCCN),U,6)=BPCFLG
Q
PROV ;
Q:'$D(^AUPNVPRV(BPCX1,0))
S BPCPDTA=^AUPNVPRV(BPCX1,0)
Q:$P(BPCPDTA,U,4)'="P"
S BPCPRV=$P(BPCPDTA,U,1),BPCPRV=$P($G(VA(200,BPCPRV,0)),U,1) S:'$L(BPCPRV) BPCPRV=BPCX1
Q
LAB ;
S BPCX1=0 F S BPCX1=$O(^AUPNVLAB("AD",BPCVSIT,BPCX1)) Q:BPCX1="" D LAB1
Q
LAB1 ;
Q:'$D(^AUPNVLAB(BPCX1,0))
S BPCY=^AUPNVLAB(BPCX1,0),BPCY11=$G(^AUPNVLAB(BPCX1,11)),BPCY12=$G(^AUPNVLAB(BPCX1,12))
S BPCTST=$P(BPCY,U,1),BPCTEST=$P($G(^LAB(60,BPCTST,0)),U,1) Q:'$L(BPCTEST)
S BPCATOM=$O(^LAB(60,BPCTST,2,0))=""
S BPCVALUE=$P(BPCY,U,4),BPCFLAGL=$P(BPCY,U,5),BPCREFL=$P(BPCY11,U,4),BPCREFH=$P(BPCY11,U,5),BPCUNITS=$P(BPCY11,U,1)
S BPCPRNT=$P(BPCY12,U,8)
S BPCCTR=BPCCTR+1,BPCTEST1=BPCTEST
I $D(^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST)) S BPCTEST1=BPCTEST_BPCCTR
S BPCSITE="" I $L($P(BPCY11,U,3)) S BPCSITE=$P(BPCY11,U,3),BPCSITE=$S(BPCSITE=72:70,BPCSITE=73:70,1:BPCSITE),BPCSITE=$P($G(^LAB(61,BPCSITE,0)),U,1)
I BPCATOM D Q
.S BPCCTR(BPCTEST)=$G(BPCCTR(BPCTEST))+1
.S BPCCDT=$P(BPCY12,U,1) S:BPCCDT="" BPCCDT=BPCVDT
. I BPCPRNT'="",$D(^BGUTMP(BPCSUB,BPCX,"PARENT",BPCPRNT)) D Q
..S BPCTEST1=^BGUTMP(BPCSUB,BPCX,"PARENT",BPCPRNT)
..S ^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1,BPCTST)=BPCVDT_U_"LAB"_U_" "_BPCTEST_U_BPCX1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
..S $P(^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1),U,10)=BPCSITE
.S ^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_U_BPCX1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
S ^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_" <<PANEL>>"_U_BPCX1 ;_"^^^^^^"_BPCSITE
S ^BGUTMP(BPCSUB,BPCX,"PARENT",BPCX1)=BPCTEST1
Q
POV ;
S BPCPVDTA=0
S BPCX1=0 F S BPCX1=$O(^AUPNVPOV("AD",BPCVSIT,BPCX1)) Q:BPCX1="" D POV1
S:'BPCPVDTA ^BGUTMP(BPCSUB,BPCX,"POV",1)=BPCVDT_U_"POV"_U_"No Purpose of Visit Recorded"
K BPCPVDTA
Q
POV1 ;
Q:'$D(^AUPNVPOV(BPCX1,0))
S BPCPDTA=$G(^AUPNVPOV(BPCX1,0))
S BPCY=$P(BPCPDTA,U,1) Q:'$L(BPCY)
S BPCPOV=$P($G(^ICD9(BPCY,0)),U,3)
S BPCY=$P(BPCPDTA,U,4) Q:'$L(BPCY)
S BPCNAR=$G(^AUTNPOV(BPCY,0))
S ^BGUTMP(BPCSUB,BPCX,"POV",BPCX1)=BPCVDT_U_"POV"_U_BPCPOV_U_BPCNAR_U_BPCX1,BPCPVDTA=1
Q
MED ;
S BPCX1=0 F S BPCX1=$O(^AUPNVMED("AD",BPCVSIT,BPCX1)) Q:BPCX1="" D MED1
Q
MED1 ;
Q:'$D(^AUPNVMED(BPCX1,0))
S BPCF=1
Q
;FHL 12/9/97
D:$D(^PSRX("APCC",BPCX1)) Q:BPCRXST'="0"
.S BPCRXST="0"
.S BPCX2=$O(^PSRX("APCC",BPCX1,""))
.S:BPCX2'="" BPCRXD=^PSRX(BPCX2,0),BPCRXST=$P(BPCRXD,U,15)
S BPCY=^AUPNVMED(BPCX1,0),BPCY12=$G(^AUPNVMED(BPCX1,12))
S BPCMED=$P(BPCY,U,1),BPCMED=$P($G(^PSDRUG(BPCMED,0)),U,1) Q:'$L(BPCMED)
S BPCDNAM=$P(BPCY,U,4),BPCSIG=$P(BPCY,U,5),BPCQTY=$P(BPCY,U,6),BPCDAYS=$P(BPCY,U,7),BPCDDAY=$P(BPCY,U,8)
S BPCCDT=$P(BPCY12,U,1) S:BPCCDT="" BPCCDT=BPCVDT
S ^BGUTMP(BPCSUB,BPCX,"MED",BPCMED)=BPCVDT_U_"MED"_U_BPCMED_U_BPCX1_U_BPCDNAM_U_BPCSIG_U_BPCQTY_U_BPCDAYS_U_BPCCDT
Q
SETRES ;
S BPCX=0,BPCCTR=2 F S BPCX=$O(^BGUTMP(BPCSUB,BPCX)) Q:BPCX="" D
.S BPCY="" F S BPCY=$O(^BGUTMP(BPCSUB,BPCX,BPCY)) Q:BPCY="" D:BPCY'="PARENT"
..S BPCZ="" F S BPCZ=$O(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ)) Q:BPCZ="" D
...S BPCDD=$G(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ))
...;S:BPCY'="VISIT" ^BGURES(BPCSUB,BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ),BPCCTR=BPCCTR+1
...S:BPCDD'="" ^BGURES(BPCSUB,BPCCTR)=BPCDD,BPCCTR=BPCCTR+1
...I $O(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ,""))'="" D Q
....S BPCQ="" F S BPCQ=$O(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ,BPCQ)) Q:BPCQ="" D
.....S ^BGURES(BPCSUB,BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ,BPCQ),BPCCTR=BPCCTR+1
;S BPCX=0,BPCCTR=2 F S BPCX=$O(^BGUTMP(BPCSUB,BPCX)) Q:BPCX="" S BPCY="" F S BPCY=$O(^BGUTMP(BPCSUB,BPCX,BPCY)) Q:BPCY="" S BPCZ="" F S BPCZ=$O(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ)) Q:BPCZ="" D SETRES1
D TRENDS,ALERTS,REMARKS,NOK,SITEP
;S RESULT(1)=BPCCTR-1
S ^BGURES(BPCSUB,1)=BPCCTR-1
Q
SETRES1 ;
;S RESULT(BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ),BPCCTR=BPCCTR+1
S ^BGURES(BPCSUB,BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ),BPCCTR=BPCCTR+1
Q
TRENDS ;
D TRENDS^BPCLALL
Q
ALERTS ;
D ALERTS^BPCLALL
Q
D REMARKS^BPCLALL
Q
NOK ;
D NOK^BPCLALL1
Q
SITEP ;
D SITEP^BPCLALL1
Q
MEAS ;
D MEAS^BPCLALL1
Q
BPCPC ; IHS/OIT/MJL - PATIENT CHART RELATED ROUTINES FOR GUI ;
+1 ;;1.5;BPC;;MAY 26, 2005
BPCCHT(RESULT,BPCIEN,BPCOPT,BPCLIM,BPCSDATE,BPCEDATE) ;EP CALL FROM REMOTE PROC: BPC CHARTDATA
+1 ;
+2 ;POSSIBLE OPTIONS (BPCOPT)
+3 ;1 - RETURN CHOSEN NUMBER OF VISITS (BPCLIM) WITHIN DATE RANGE
+4 ;2 - RETURN ALL VISITS WITHIN DATE RANGE
+5 ;3 - RETURN LAB VISITS ONLY WITHIN DATE RANGE
EN ;
+1 SET U="^"
SET XWBWRAP=1
SET BPCLIM=$GET(BPCLIM,10)
SET BPCSUB=$JOB
SET BPCMFLG=""
KILL ^BGUTMP(BPCSUB),^BGURES(BPCSUB),RESULT
+2 IF 'BPCLIM
SET BPCLIM=10
+3 SET RESULT="^BGURES("_BPCSUB_")"
+4 ;I '$D(BPCIEN) S RESULT(1)=-1,RESULT(2)="NO PATIENT IEN SENT!" Q
+5 IF '$DATA(BPCIEN)
SET ^BGURES(BPCSUB,1)=-1
SET ^BGURES(BPCSUB,2)="NO PATIENT IEN SENT!"
QUIT
+6 SET BPCOPT=$GET(BPCOPT,1)
SET BPCSDATE=$GET(BPCSDATE)
SET BPCEDATE=$GET(BPCEDATE)
+7 IF BPCOPT=2
SET BPCLIM=9999999
+8 IF BPCSDATE'=""
SET BPCFLG=0
DO GETDATES
IF BPCFLG
DO KILL
QUIT
+9 DO VISIT
DO SETRES
DO KILL
+10 QUIT
GETDATES ;
+1 DO DT^DILF("",BPCSDATE,.BPCSDAT)
+2 ;I BPCSDAT=-1 S RESULT(1)=-1,RESULT(2)="INVALID START DATE!",BPCFLG=1 Q
+3 IF BPCSDAT=-1
SET ^BGURES(BPCSUB,1)=-1
SET ^BGURES(BPCSUB,2)="INVALID START DATE!"
SET BPCFLG=1
QUIT
+4 IF BPCEDATE=""
SET BPCEDATE="T"
+5 DO DT^DILF("",BPCEDATE,.BPCEDAT)
+6 ;I BPCEDAT=-1 S RESULT(1)=-1,RESULT(2)="INVALID END DATE!",BPCFLG=1
+7 IF BPCEDAT=-1
SET ^BGURES(BPCSUB,1)=-1
SET ^BGURES(BPCSUB,2)="INVALID END DATE!"
SET BPCFLG=1
+8 QUIT
KILL ;
+1 KILL ^BGUTMP(BPCSUB)
+2 KILL BPCPRV,BPCCDT,BPCCLIN,BPCCN,BPCCTR,BPCDAYS,BPCDDAY,BPCDNAM,BPCDTA,BPCEDATE,BPCFATH,BPCFLAGL,BPCFLG,BPCIEN,BPCLIM,BPCLOC,BPCMED
+3 KILL BPCMOTH1,BPCMOTH2,BPCNAR,BPCOPT,BPCPDTA,BPCPOV,BPCQTY,BPCREFH,BPCREFL,BPCSC,BPCSDATE,BPCSIG,BPCSITE,BPCSUB,BPCTEST,BPCTEST1,BPCUNITS,BPCVALUE
+4 KILL BPCVDT,BPCVSIT,BPCX,BPCX1,BPCY,BPCY11,BPCY12,BPCZ,BPCCKDT,BPCSDAT,BPCEDAT,BPCDD,BPCF
+5 QUIT
VISIT ;
+1 SET BPCX=0
SET BPCCN=0
SET BPCCTR=0
FOR
SET BPCX=$ORDER(^AUPNVSIT("AA",BPCIEN,BPCX))
IF BPCX=""
QUIT
SET BPCVSIT=""
Begin DoDot:1
+2 FOR
SET BPCVSIT=$ORDER(^AUPNVSIT("AA",BPCIEN,BPCX,BPCVSIT))
IF BPCVSIT=""
QUIT
DO VISIT1
IF BPCCN=BPCLIM
QUIT
End DoDot:1
IF BPCCN=BPCLIM
QUIT
+3 QUIT
VISIT1 ;
+1 SET BPCMFLG=$SELECT($DATA(^AUPNVMIC("AD",BPCVSIT)):"B",1:"")
+2 ;IF OPTION=LABS ONLY
IF BPCOPT=3
IF '$DATA(^AUPNVLAB("AD",BPCVSIT))
QUIT
+3 SET BPCY=^AUPNVSIT(BPCVSIT,0)
SET BPCVDT=$PIECE(BPCY,U,1)
SET BPCLOC=$PIECE(BPCY,U,6)
SET BPCSC=$PIECE(BPCY,U,7)
SET BPCCLIN=$PIECE(BPCY,U,8)
SET BPCCKDT=$PIECE(BPCVDT,".",1)
+4 ;IF NOT IN DATE RANGE
IF BPCSDATE'=""
IF BPCEDATE'=""
IF ((BPCCKDT<BPCSDAT)!(BPCCKDT>BPCEDAT))
QUIT
+5 IF $LENGTH(BPCLOC)
SET BPCLOC=$GET(^AUTTLOC(BPCLOC,0))
IF $LENGTH(BPCLOC)
SET BPCLOC=$PIECE(BPCLOC,U,2)
+6 IF $LENGTH(BPCCLIN)
SET BPCCLIN=$GET(^DIC(40.7,BPCCLIN,0))
IF $LENGTH(BPCCLIN)
SET BPCCLIN=$PIECE(BPCCLIN,U,1)
+7 SET BPCX1=0
FOR
SET BPCX1=$ORDER(^AUPNVPRV("AD",BPCVSIT,BPCX1))
IF BPCX1=""
QUIT
DO PROV
+8 SET BPCCN=BPCCN+1
SET ^BGUTMP(BPCSUB,BPCX,"VISIT","NONE",BPCCN)=BPCVDT_U_"VISIT"_U_BPCVSIT_U_BPCLOC_U_BPCSC_U_$GET(BPCPRV)_U_BPCCLIN
+9 DO LAB
DO POV
DO MEAS
+10 SET BPCFLG=""
IF $DATA(^BGUTMP(BPCSUB,BPCX,"LAB"))
SET BPCFLG="L"
IF $DATA(^BGUTMP(BPCSUB,BPCX,"POV"))
SET BPCFLG=BPCFLG_"P"
+11 SET BPCF=0
+12 DO MED
IF BPCF
SET BPCFLG=BPCFLG_"M"
+13 ;S:$D(^BGUTMP(BPCSUB,BPCX,"MED")) BPCFLG=BPCFLG_"M"
+14 ;S $P(^BGUTMP(BPCSUB,BPCX,"VISIT","NONE"),U,6)=BPCFLG
+15 SET BPCFLG=BPCFLG_BPCMFLG
SET $PIECE(^BGUTMP(BPCSUB,BPCX,"VISIT","NONE",BPCCN),U,6)=BPCFLG
+16 QUIT
PROV ;
+1 IF '$DATA(^AUPNVPRV(BPCX1,0))
QUIT
+2 SET BPCPDTA=^AUPNVPRV(BPCX1,0)
+3 IF $PIECE(BPCPDTA,U,4)'="P"
QUIT
+4 SET BPCPRV=$PIECE(BPCPDTA,U,1)
SET BPCPRV=$PIECE($GET(VA(200,BPCPRV,0)),U,1)
IF '$LENGTH(BPCPRV)
SET BPCPRV=BPCX1
+5 QUIT
LAB ;
+1 SET BPCX1=0
FOR
SET BPCX1=$ORDER(^AUPNVLAB("AD",BPCVSIT,BPCX1))
IF BPCX1=""
QUIT
DO LAB1
+2 QUIT
LAB1 ;
+1 IF '$DATA(^AUPNVLAB(BPCX1,0))
QUIT
+2 SET BPCY=^AUPNVLAB(BPCX1,0)
SET BPCY11=$GET(^AUPNVLAB(BPCX1,11))
SET BPCY12=$GET(^AUPNVLAB(BPCX1,12))
+3 SET BPCTST=$PIECE(BPCY,U,1)
SET BPCTEST=$PIECE($GET(^LAB(60,BPCTST,0)),U,1)
IF '$LENGTH(BPCTEST)
QUIT
+4 SET BPCATOM=$ORDER(^LAB(60,BPCTST,2,0))=""
+5 SET BPCVALUE=$PIECE(BPCY,U,4)
SET BPCFLAGL=$PIECE(BPCY,U,5)
SET BPCREFL=$PIECE(BPCY11,U,4)
SET BPCREFH=$PIECE(BPCY11,U,5)
SET BPCUNITS=$PIECE(BPCY11,U,1)
+6 SET BPCPRNT=$PIECE(BPCY12,U,8)
+7 SET BPCCTR=BPCCTR+1
SET BPCTEST1=BPCTEST
+8 IF $DATA(^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST))
SET BPCTEST1=BPCTEST_BPCCTR
+9 SET BPCSITE=""
IF $LENGTH($PIECE(BPCY11,U,3))
SET BPCSITE=$PIECE(BPCY11,U,3)
SET BPCSITE=$SELECT(BPCSITE=72:70,BPCSITE=73:70,1:BPCSITE)
SET BPCSITE=$PIECE($GET(^LAB(61,BPCSITE,0)),U,1)
+10 IF BPCATOM
Begin DoDot:1
+11 SET BPCCTR(BPCTEST)=$GET(BPCCTR(BPCTEST))+1
+12 SET BPCCDT=$PIECE(BPCY12,U,1)
IF BPCCDT=""
SET BPCCDT=BPCVDT
+13 IF BPCPRNT'=""
IF $DATA(^BGUTMP(BPCSUB,BPCX,"PARENT",BPCPRNT))
Begin DoDot:2
+14 SET BPCTEST1=^BGUTMP(BPCSUB,BPCX,"PARENT",BPCPRNT)
+15 SET ^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1,BPCTST)=BPCVDT_U_"LAB"_U_" "_BPCTEST_U_BPCX1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
+16 SET $PIECE(^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1),U,10)=BPCSITE
End DoDot:2
QUIT
+17 SET ^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_U_BPCX1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
End DoDot:1
QUIT
+18 ;_"^^^^^^"_BPCSITE
SET ^BGUTMP(BPCSUB,BPCX,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_" <<PANEL>>"_U_BPCX1
+19 SET ^BGUTMP(BPCSUB,BPCX,"PARENT",BPCX1)=BPCTEST1
+20 QUIT
POV ;
+1 SET BPCPVDTA=0
+2 SET BPCX1=0
FOR
SET BPCX1=$ORDER(^AUPNVPOV("AD",BPCVSIT,BPCX1))
IF BPCX1=""
QUIT
DO POV1
+3 IF 'BPCPVDTA
SET ^BGUTMP(BPCSUB,BPCX,"POV",1)=BPCVDT_U_"POV"_U_"No Purpose of Visit Recorded"
+4 KILL BPCPVDTA
+5 QUIT
POV1 ;
+1 IF '$DATA(^AUPNVPOV(BPCX1,0))
QUIT
+2 SET BPCPDTA=$GET(^AUPNVPOV(BPCX1,0))
+3 SET BPCY=$PIECE(BPCPDTA,U,1)
IF '$LENGTH(BPCY)
QUIT
+4 SET BPCPOV=$PIECE($GET(^ICD9(BPCY,0)),U,3)
+5 SET BPCY=$PIECE(BPCPDTA,U,4)
IF '$LENGTH(BPCY)
QUIT
+6 SET BPCNAR=$GET(^AUTNPOV(BPCY,0))
+7 SET ^BGUTMP(BPCSUB,BPCX,"POV",BPCX1)=BPCVDT_U_"POV"_U_BPCPOV_U_BPCNAR_U_BPCX1
SET BPCPVDTA=1
+8 QUIT
MED ;
+1 SET BPCX1=0
FOR
SET BPCX1=$ORDER(^AUPNVMED("AD",BPCVSIT,BPCX1))
IF BPCX1=""
QUIT
DO MED1
+2 QUIT
MED1 ;
+1 IF '$DATA(^AUPNVMED(BPCX1,0))
QUIT
+2 SET BPCF=1
+3 QUIT
+4 ;FHL 12/9/97
+5 IF $DATA(^PSRX("APCC",BPCX1))
Begin DoDot:1
+6 SET BPCRXST="0"
+7 SET BPCX2=$ORDER(^PSRX("APCC",BPCX1,""))
+8 IF BPCX2'=""
SET BPCRXD=^PSRX(BPCX2,0)
SET BPCRXST=$PIECE(BPCRXD,U,15)
End DoDot:1
IF BPCRXST'="0"
QUIT
+9 SET BPCY=^AUPNVMED(BPCX1,0)
SET BPCY12=$GET(^AUPNVMED(BPCX1,12))
+10 SET BPCMED=$PIECE(BPCY,U,1)
SET BPCMED=$PIECE($GET(^PSDRUG(BPCMED,0)),U,1)
IF '$LENGTH(BPCMED)
QUIT
+11 SET BPCDNAM=$PIECE(BPCY,U,4)
SET BPCSIG=$PIECE(BPCY,U,5)
SET BPCQTY=$PIECE(BPCY,U,6)
SET BPCDAYS=$PIECE(BPCY,U,7)
SET BPCDDAY=$PIECE(BPCY,U,8)
+12 SET BPCCDT=$PIECE(BPCY12,U,1)
IF BPCCDT=""
SET BPCCDT=BPCVDT
+13 SET ^BGUTMP(BPCSUB,BPCX,"MED",BPCMED)=BPCVDT_U_"MED"_U_BPCMED_U_BPCX1_U_BPCDNAM_U_BPCSIG_U_BPCQTY_U_BPCDAYS_U_BPCCDT
+14 QUIT
SETRES ;
+1 SET BPCX=0
SET BPCCTR=2
FOR
SET BPCX=$ORDER(^BGUTMP(BPCSUB,BPCX))
IF BPCX=""
QUIT
Begin DoDot:1
+2 SET BPCY=""
FOR
SET BPCY=$ORDER(^BGUTMP(BPCSUB,BPCX,BPCY))
IF BPCY=""
QUIT
IF BPCY'="PARENT"
Begin DoDot:2
+3 SET BPCZ=""
FOR
SET BPCZ=$ORDER(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ))
IF BPCZ=""
QUIT
Begin DoDot:3
+4 SET BPCDD=$GET(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ))
+5 ;S:BPCY'="VISIT" ^BGURES(BPCSUB,BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ),BPCCTR=BPCCTR+1
+6 IF BPCDD'=""
SET ^BGURES(BPCSUB,BPCCTR)=BPCDD
SET BPCCTR=BPCCTR+1
+7 IF $ORDER(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ,""))'=""
Begin DoDot:4
+8 SET BPCQ=""
FOR
SET BPCQ=$ORDER(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ,BPCQ))
IF BPCQ=""
QUIT
Begin DoDot:5
+9 SET ^BGURES(BPCSUB,BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ,BPCQ)
SET BPCCTR=BPCCTR+1
End DoDot:5
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;S BPCX=0,BPCCTR=2 F S BPCX=$O(^BGUTMP(BPCSUB,BPCX)) Q:BPCX="" S BPCY="" F S BPCY=$O(^BGUTMP(BPCSUB,BPCX,BPCY)) Q:BPCY="" S BPCZ="" F S BPCZ=$O(^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ)) Q:BPCZ="" D SETRES1
+11 DO TRENDS
DO ALERTS
DO REMARKS
DO NOK
DO SITEP
+12 ;S RESULT(1)=BPCCTR-1
+13 SET ^BGURES(BPCSUB,1)=BPCCTR-1
+14 QUIT
SETRES1 ;
+1 ;S RESULT(BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ),BPCCTR=BPCCTR+1
+2 SET ^BGURES(BPCSUB,BPCCTR)=^BGUTMP(BPCSUB,BPCX,BPCY,BPCZ)
SET BPCCTR=BPCCTR+1
+3 QUIT
TRENDS ;
+1 DO TRENDS^BPCLALL
+2 QUIT
ALERTS ;
+1 DO ALERTS^BPCLALL
+2 QUIT
+1 DO REMARKS^BPCLALL
+2 QUIT
NOK ;
+1 DO NOK^BPCLALL1
+2 QUIT
SITEP ;
+1 DO SITEP^BPCLALL1
+2 QUIT
MEAS ;
+1 DO MEAS^BPCLALL1
+2 QUIT
