- 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
