BPCLALL ; IHS/OIT/MJL - PCC VISIT LIST FOR GUI ;
;;1.5;BPC;;MAY 26, 2005
;GETS PCC VISIT DATA
EN ;ENTRY POINT
S U="^",BPCLIM=20,BPCSUB=$J K ^BGUTMP($J),RESULT,^BGURES($J)
S RESULT="^BGURES("_BPCSUB_")"
I '$D(BPCIEN) S ^BGURES(BPCSUB,1)=-1,^BGURES(BPCSUB,2)="NO Lab internal entry found! (BPCIEN)" Q
;I '$D(BPCIEN) S RESULT(1)=-1,RESULT(2)="NO Lab internal entry found! (BPCIEN)" Q
S X=0,BPCCNT=0 F I=1:1:BPCLIM S X=$O(^AUPNVSIT("AA",BPCIEN,X)) Q:+X=0 S BPCVSIT="" F S BPCVSIT=$O(^AUPNVSIT("AA",BPCIEN,X,BPCVSIT)) Q:BPCVSIT="" D VISIT
S X=0,BPCCTR=2 F S X=$O(^BGUTMP($J,X)) Q:+X=0 S Y="" F S Y=$O(^BGUTMP($J,X,Y)) Q:Y="" S Z="" F S Z=$O(^BGUTMP($J,X,Y,Z)) Q:Z="" S ^BGURES(BPCSUB,BPCCTR)=^BGUTMP($J,X,Y,Z),BPCCTR=BPCCTR+1
D TRENDS,ALERTS,REMARKS,NOK,SITEP
S ^BGURES(BPCSUB,1)=BPCCTR-1
K BPCCTR,^BGUTMP($J),BPCV
Q
;
VISIT ;
S BPCV=$G(BPCV)+1
S Y=^AUPNVSIT(BPCVSIT,0),BPCVDT=$P(Y,U,1),BPCLOC=$P(Y,U,6),BPCSC=$P(Y,U,7),BPCCLIN=$P(Y,U,8)
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 X1=0 F S X1=$O(^AUPNVPRV("AD",BPCVSIT,X1)) Q:+X1=0 D
. Q:'$D(^AUPNVPRV(X1,0))
. Q:$P(^AUPNVPRV(X1,0),U,4)'="P"
. S BPCPRV=$P(X1,U,1),BPCPRV=$P($G(^VA(200,BPCPRV,0)),U,1) S:'$L(BPCPRV) BPCPRV=X1
S ^BGUTMP($J,X,"VISIT","NONE")=BPCVDT_U_"VISIT"_U_BPCVSIT_U_BPCLOC_U_$G(BPCPRV)_U_BPCSC_U_BPCCLIN D LAB,POV,MED
S BPCFLG="" S:$D(^BGUTMP($J,X,"LAB")) BPCFLG="L" S:$D(^BGUTMP($J,X,"POV")) BPCFLG=BPCFLG_"P" S:$D(^BGUTMP($J,X,"MED")) BPCFLG=BPCFLG_"M" S $P(^BGUTMP($J,X,"VISIT","NONE"),U,6)=BPCFLG
Q
;
VST2 ;
Q:$P(^AUPNVPRV(X1,0),U,4)'="P"
S BPCPRV=$P(X1,U,1),BPCPRV=$P($G(^VA(200,BPCPRV,0)),U,1) S:'$L(BPCPRV) BPCPRV=X1
Q
;
LAB ;
S X1=0 F S X1=$O(^AUPNVLAB("AD",BPCVSIT,X1)) Q:+X1=0 D
. Q:'$D(^AUPNVLAB(X1,0))
. S Y=^AUPNVLAB(X1,0),Y11=$G(^AUPNVLAB(X1,11)),Y12=$G(^AUPNVLAB(X1,12))
. S BPCTEST=$P(Y,U,1),BPCTEST=$P($G(^LAB(60,BPCTEST,0)),U,1) Q:'$L(BPCTEST)
. S BPCVALUE=$P(Y,U,4),BPCFLAGL=$P(Y,U,5),BPCREFL=$P(Y11,U,4),BPCREFH=$P(Y11,U,5),BPCUNITS=$P(Y11,U,1)
. S BPCSITE="" I $L($P(Y11,U,3)) S BPCSITE=$P(Y11,U,3),BPCSITE=$S(BPCSITE=72:70,BPCSITE=73:BPCSITE=70,1:BPCSITE),BPCSITE=$P($G(^LAB(61,BPCSITE,0)),U,1)
. S BPCCTR(BPCTEST)=$G(BPCCTR(BPCTEST))+1
. S BPCCDT=$P(Y12,U,1) S:BPCCDT="" BPCCDT=BPCVDT
. S BPCTEST1=BPCTEST,BPCCNT=BPCCNT+1
. I $D(^BGUTMP($J,X,"LAB",BPCTEST)) S BPCTEST1=BPCTEST_BPCCNT
. S ^BGUTMP($J,X,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_U_X1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
Q
;
MED S X1=0 F S X1=$O(^AUPNVMED("AD",BPCVSIT,X1)) Q:+X1=0 D
. Q:'$D(^AUPNVMED(X1,0))
. S Y=^AUPNVMED(X1,0),Y12=$G(^AUPNVMED(X1,12))
. S BPCMED=$P(Y,U,1),BPCMED=$P($G(^PSDRUG(BPCMED,0)),U,1) Q:'$L(BPCMED)
. S BPCDNAM=$P(Y,U,4),BPCSIG=$P(Y,U,5),BPCQTY=$P(Y,U,6),BPCDAYS=$P(Y,U,7),BPCDDAY=$P(Y,U,8)
. S BPCCDT=$P(Y12,U,1) S:BPCCDT="" BPCCDT=BPCVDT
. S ^BGUTMP($J,X,"MED",BPCMED)=BPCVDT_U_"MED"_U_BPCMED_U_X1_U_BPCDNAM_U_BPCSIG_U_BPCQTY_U_BPCDAYS_U_BPCCDT
Q
;
POV S X1=0 F S X1=$O(^AUPNVPOV("AD",BPCVSIT,X1)) Q:+X1=0 D
. Q:'$D(^AUPNVPOV(X1,0))
. S BPCDTA=$G(^AUPNVPOV(X1,0))
. S Y=$P(BPCDTA,U,1) Q:'$L(Y)
. S BPCPOV=$P($G(^ICD9(Y,0)),U,3)
. S Y=$P(BPCDTA,U,4) Q:'$L(Y)
. S BPCNAR=$G(^AUTNPOV(Y,0))
. S ^BGUTMP($J,X,"POV",X1)=BPCVDT_U_"POV"_U_BPCPOV_U_BPCNAR_U_X1
Q
;
TRENDS ;EP ADD TEST COUNTS FOR TRENDING TO RESULT ARRAY FROM BPCPC
;S BPCTEST="" F S BPCTEST=$O(BPCCTR(BPCTEST)) Q:BPCTEST="" S RESULT(BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST),BPCCTR=BPCCTR+1
S BPCTEST="" F S BPCTEST=$O(BPCCTR(BPCTEST)) Q:BPCTEST="" S ^BGURES(BPCSUB,BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST),BPCCTR=BPCCTR+1
Q
ALERTS ;EP ADD ALERT DATA FROM BPCPC
;I '$D(^AUPNPAT(BPCIEN,15)) S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1 Q
I '$D(^AUPNPAT(BPCIEN,15)) S ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1 Q
;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,15,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,15,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="ALERT"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,15,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,15,BPCX,0)) I BPCDTA'="" S ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
;I 'BPCFLG S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1
I 'BPCFLG S ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1
Q
;I '$D(^AUPNPAT(BPCIEN,14)) S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1 Q
I '$D(^AUPNPAT(BPCIEN,14)) S ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1 Q
;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,14,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,14,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="REMARK"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,14,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,14,BPCX,0)) I BPCDTA'="" S ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
;I 'BPCFLG S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1
I 'BPCFLG S ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1
Q
NOK ; ADD NEXT OF KIN DATA
D NOK^BPCLALL1
Q
SITEP ;
D SITEP^BPCLALL1
Q
BPCLALL ; IHS/OIT/MJL - PCC VISIT LIST FOR GUI ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;GETS PCC VISIT DATA
EN ;ENTRY POINT
+1 SET U="^"
SET BPCLIM=20
SET BPCSUB=$JOB
KILL ^BGUTMP($JOB),RESULT,^BGURES($JOB)
+2 SET RESULT="^BGURES("_BPCSUB_")"
+3 IF '$DATA(BPCIEN)
SET ^BGURES(BPCSUB,1)=-1
SET ^BGURES(BPCSUB,2)="NO Lab internal entry found! (BPCIEN)"
QUIT
+4 ;I '$D(BPCIEN) S RESULT(1)=-1,RESULT(2)="NO Lab internal entry found! (BPCIEN)" Q
+5 SET X=0
SET BPCCNT=0
FOR I=1:1:BPCLIM
SET X=$ORDER(^AUPNVSIT("AA",BPCIEN,X))
IF +X=0
QUIT
SET BPCVSIT=""
FOR
SET BPCVSIT=$ORDER(^AUPNVSIT("AA",BPCIEN,X,BPCVSIT))
IF BPCVSIT=""
QUIT
DO VISIT
+6 SET X=0
SET BPCCTR=2
FOR
SET X=$ORDER(^BGUTMP($JOB,X))
IF +X=0
QUIT
SET Y=""
FOR
SET Y=$ORDER(^BGUTMP($JOB,X,Y))
IF Y=""
QUIT
SET Z=""
FOR
SET Z=$ORDER(^BGUTMP($JOB,X,Y,Z))
IF Z=""
QUIT
SET ^BGURES(BPCSUB,BPCCTR)=^BGUTMP($JOB,X,Y,Z)
SET BPCCTR=BPCCTR+1
+7 DO TRENDS
DO ALERTS
DO REMARKS
DO NOK
DO SITEP
+8 SET ^BGURES(BPCSUB,1)=BPCCTR-1
+9 KILL BPCCTR,^BGUTMP($JOB),BPCV
+10 QUIT
+11 ;
VISIT ;
+1 SET BPCV=$GET(BPCV)+1
+2 SET Y=^AUPNVSIT(BPCVSIT,0)
SET BPCVDT=$PIECE(Y,U,1)
SET BPCLOC=$PIECE(Y,U,6)
SET BPCSC=$PIECE(Y,U,7)
SET BPCCLIN=$PIECE(Y,U,8)
+3 IF $LENGTH(BPCLOC)
SET BPCLOC=$GET(^AUTTLOC(BPCLOC,0))
IF $LENGTH(BPCLOC)
SET BPCLOC=$PIECE(BPCLOC,U,2)
+4 IF $LENGTH(BPCCLIN)
SET BPCCLIN=$GET(^DIC(40.7,BPCCLIN,0))
IF $LENGTH(BPCCLIN)
SET BPCCLIN=$PIECE(BPCCLIN,U,1)
+5 SET X1=0
FOR
SET X1=$ORDER(^AUPNVPRV("AD",BPCVSIT,X1))
IF +X1=0
QUIT
Begin DoDot:1
+6 IF '$DATA(^AUPNVPRV(X1,0))
QUIT
+7 IF $PIECE(^AUPNVPRV(X1,0),U,4)'="P"
QUIT
+8 SET BPCPRV=$PIECE(X1,U,1)
SET BPCPRV=$PIECE($GET(^VA(200,BPCPRV,0)),U,1)
IF '$LENGTH(BPCPRV)
SET BPCPRV=X1
End DoDot:1
+9 SET ^BGUTMP($JOB,X,"VISIT","NONE")=BPCVDT_U_"VISIT"_U_BPCVSIT_U_BPCLOC_U_$GET(BPCPRV)_U_BPCSC_U_BPCCLIN
DO LAB
DO POV
DO MED
+10 SET BPCFLG=""
IF $DATA(^BGUTMP($JOB,X,"LAB"))
SET BPCFLG="L"
IF $DATA(^BGUTMP($JOB,X,"POV"))
SET BPCFLG=BPCFLG_"P"
IF $DATA(^BGUTMP($JOB,X,"MED"))
SET BPCFLG=BPCFLG_"M"
SET $PIECE(^BGUTMP($JOB,X,"VISIT","NONE"),U,6)=BPCFLG
+11 QUIT
+12 ;
VST2 ;
+1 IF $PIECE(^AUPNVPRV(X1,0),U,4)'="P"
QUIT
+2 SET BPCPRV=$PIECE(X1,U,1)
SET BPCPRV=$PIECE($GET(^VA(200,BPCPRV,0)),U,1)
IF '$LENGTH(BPCPRV)
SET BPCPRV=X1
+3 QUIT
+4 ;
LAB ;
+1 SET X1=0
FOR
SET X1=$ORDER(^AUPNVLAB("AD",BPCVSIT,X1))
IF +X1=0
QUIT
Begin DoDot:1
+2 IF '$DATA(^AUPNVLAB(X1,0))
QUIT
+3 SET Y=^AUPNVLAB(X1,0)
SET Y11=$GET(^AUPNVLAB(X1,11))
SET Y12=$GET(^AUPNVLAB(X1,12))
+4 SET BPCTEST=$PIECE(Y,U,1)
SET BPCTEST=$PIECE($GET(^LAB(60,BPCTEST,0)),U,1)
IF '$LENGTH(BPCTEST)
QUIT
+5 SET BPCVALUE=$PIECE(Y,U,4)
SET BPCFLAGL=$PIECE(Y,U,5)
SET BPCREFL=$PIECE(Y11,U,4)
SET BPCREFH=$PIECE(Y11,U,5)
SET BPCUNITS=$PIECE(Y11,U,1)
+6 SET BPCSITE=""
IF $LENGTH($PIECE(Y11,U,3))
SET BPCSITE=$PIECE(Y11,U,3)
SET BPCSITE=$SELECT(BPCSITE=72:70,BPCSITE=73:BPCSITE=70,1:BPCSITE)
SET BPCSITE=$PIECE($GET(^LAB(61,BPCSITE,0)),U,1)
+7 SET BPCCTR(BPCTEST)=$GET(BPCCTR(BPCTEST))+1
+8 SET BPCCDT=$PIECE(Y12,U,1)
IF BPCCDT=""
SET BPCCDT=BPCVDT
+9 SET BPCTEST1=BPCTEST
SET BPCCNT=BPCCNT+1
+10 IF $DATA(^BGUTMP($JOB,X,"LAB",BPCTEST))
SET BPCTEST1=BPCTEST_BPCCNT
+11 SET ^BGUTMP($JOB,X,"LAB",BPCTEST1)=BPCVDT_U_"LAB"_U_BPCTEST_U_X1_U_BPCVALUE_U_BPCFLAGL_U_BPCUNITS_U_BPCREFL_U_BPCREFH_U_BPCSITE_U_BPCCDT
End DoDot:1
+12 QUIT
+13 ;
MED SET X1=0
FOR
SET X1=$ORDER(^AUPNVMED("AD",BPCVSIT,X1))
IF +X1=0
QUIT
Begin DoDot:1
+1 IF '$DATA(^AUPNVMED(X1,0))
QUIT
+2 SET Y=^AUPNVMED(X1,0)
SET Y12=$GET(^AUPNVMED(X1,12))
+3 SET BPCMED=$PIECE(Y,U,1)
SET BPCMED=$PIECE($GET(^PSDRUG(BPCMED,0)),U,1)
IF '$LENGTH(BPCMED)
QUIT
+4 SET BPCDNAM=$PIECE(Y,U,4)
SET BPCSIG=$PIECE(Y,U,5)
SET BPCQTY=$PIECE(Y,U,6)
SET BPCDAYS=$PIECE(Y,U,7)
SET BPCDDAY=$PIECE(Y,U,8)
+5 SET BPCCDT=$PIECE(Y12,U,1)
IF BPCCDT=""
SET BPCCDT=BPCVDT
+6 SET ^BGUTMP($JOB,X,"MED",BPCMED)=BPCVDT_U_"MED"_U_BPCMED_U_X1_U_BPCDNAM_U_BPCSIG_U_BPCQTY_U_BPCDAYS_U_BPCCDT
End DoDot:1
+7 QUIT
+8 ;
POV SET X1=0
FOR
SET X1=$ORDER(^AUPNVPOV("AD",BPCVSIT,X1))
IF +X1=0
QUIT
Begin DoDot:1
+1 IF '$DATA(^AUPNVPOV(X1,0))
QUIT
+2 SET BPCDTA=$GET(^AUPNVPOV(X1,0))
+3 SET Y=$PIECE(BPCDTA,U,1)
IF '$LENGTH(Y)
QUIT
+4 SET BPCPOV=$PIECE($GET(^ICD9(Y,0)),U,3)
+5 SET Y=$PIECE(BPCDTA,U,4)
IF '$LENGTH(Y)
QUIT
+6 SET BPCNAR=$GET(^AUTNPOV(Y,0))
+7 SET ^BGUTMP($JOB,X,"POV",X1)=BPCVDT_U_"POV"_U_BPCPOV_U_BPCNAR_U_X1
End DoDot:1
+8 QUIT
+9 ;
TRENDS ;EP ADD TEST COUNTS FOR TRENDING TO RESULT ARRAY FROM BPCPC
+1 ;S BPCTEST="" F S BPCTEST=$O(BPCCTR(BPCTEST)) Q:BPCTEST="" S RESULT(BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST),BPCCTR=BPCCTR+1
+2 SET BPCTEST=""
FOR
SET BPCTEST=$ORDER(BPCCTR(BPCTEST))
IF BPCTEST=""
QUIT
SET ^BGURES(BPCSUB,BPCCTR)="TREND"_U_BPCTEST_U_BPCCTR(BPCTEST)
SET BPCCTR=BPCCTR+1
+3 QUIT
ALERTS ;EP ADD ALERT DATA FROM BPCPC
+1 ;I '$D(^AUPNPAT(BPCIEN,15)) S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1 Q
+2 IF '$DATA(^AUPNPAT(BPCIEN,15))
SET ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS"
SET BPCCTR=BPCCTR+1
QUIT
+3 ;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,15,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,15,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="ALERT"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
+4 SET BPCX=""
SET BPCFLG=0
FOR
SET BPCX=$ORDER(^AUPNPAT(BPCIEN,15,BPCX))
IF BPCX=""
QUIT
SET BPCDTA=$GET(^AUPNPAT(BPCIEN,15,BPCX,0))
IF BPCDTA'=""
SET ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_BPCDTA
SET BPCCTR=BPCCTR+1
SET BPCFLG=1
+5 ;I 'BPCFLG S RESULT(BPCCTR)="ALERT"_U_"NO ALERTS",BPCCTR=BPCCTR+1
+6 IF 'BPCFLG
SET ^BGURES(BPCSUB,BPCCTR)="ALERT"_U_"NO ALERTS"
SET BPCCTR=BPCCTR+1
+7 QUIT
+1 ;I '$D(^AUPNPAT(BPCIEN,14)) S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1 Q
+2 IF '$DATA(^AUPNPAT(BPCIEN,14))
SET ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS"
SET BPCCTR=BPCCTR+1
QUIT
+3 ;S BPCX="",BPCFLG=0 F S BPCX=$O(^AUPNPAT(BPCIEN,14,BPCX)) Q:BPCX="" S BPCDTA=$G(^AUPNPAT(BPCIEN,14,BPCX,0)) I BPCDTA'="" S RESULT(BPCCTR)="REMARK"_U_BPCDTA,BPCCTR=BPCCTR+1,BPCFLG=1
+4 SET BPCX=""
SET BPCFLG=0
FOR
SET BPCX=$ORDER(^AUPNPAT(BPCIEN,14,BPCX))
IF BPCX=""
QUIT
SET BPCDTA=$GET(^AUPNPAT(BPCIEN,14,BPCX,0))
IF BPCDTA'=""
SET ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_BPCDTA
SET BPCCTR=BPCCTR+1
SET BPCFLG=1
+5 ;I 'BPCFLG S RESULT(BPCCTR)="REMARK"_U_"NO REMARKS",BPCCTR=BPCCTR+1
+6 IF 'BPCFLG
SET ^BGURES(BPCSUB,BPCCTR)="REMARK"_U_"NO REMARKS"
SET BPCCTR=BPCCTR+1
+7 QUIT
NOK ; ADD NEXT OF KIN DATA
+1 DO NOK^BPCLALL1
+2 QUIT
SITEP ;
+1 DO SITEP^BPCLALL1
+2 QUIT
