BPCPROB ; IHS/OIT/MJL - GUI COLLECTS PROBLEM LIST DATA ;
;;1.5;BPC;;MAY 26, 2005
;
EN(RESULT,BPCIEN,BPCSDATE,BPCEDATE) ;EP CALL FROM REMOTE PROC: BPC GETPROBLEMS
S U="^",XWBWRAP=1,BPCCTR=0,BPCSUB=$J,BPCIEN=$G(BPCIEN),BPCSDATE=$G(BPCSDATE),BPCEDATE=$G(BPCEDATE) K ^BGUTMP(BPCSUB),RESULT
I BPCIEN="" S RESULT(1)="-1",RESULT(2)="NO PATIENT IEN DEFINED!" D KILL Q
I BPCSDATE="" S RESULT(1)="-1",RESULT(2)="NO STARTING DATE DEFINED!" D KILL Q
I BPCEDATE="" S RESULT(1)="-1",RESULT(2)="NO ENDING DATE DEFINED!" D KILL Q
D DT^DILF("",BPCSDATE,.BPCSDAT)
I BPCSDAT=-1 D
.S BPCSDATE="1/1/1980"
.D DT^DILF("",BPCSDATE,.BPCSDAT)
D DT^DILF("",BPCEDATE,.BPCEDAT)
I BPCEDAT=-1 D
.S BPCEDATE="T"
.D DT^DILF("",BPCEDATE,.BPCEDAT)
S BPCPRB="" F S BPCPRB=$O(^AUPNPROB("AC",BPCIEN,BPCPRB)) Q:BPCPRB="" D PRB
D SETRES,KILL
Q
KILL ;
K BPCCTR,BPCSUB,BPCPRB,BPCIEN,BPCCTR,BPCX,BPCDXP,BPCLOCP,BPCSTAT,BPCOSET,BPCNARP,BPCNBR,BPCDX,BPCPRBID,BPCNAR,BPCDTMOD,BPCDTENT,BPCCLS,BPCLOCC,BPCLOCN
Q
PRB ;
S BPCCTR=BPCCTR+1
S BPCX=^AUPNPROB(BPCPRB,0)
Q:$P($G(BPCX),U,3)<BPCSDATE
S BPCDXP=$P(BPCX,U,1),BPCLOCP=$P(BPCX,U,6),BPCSTAT=$S($P(BPCX,U,12)="A":"ACTIVE",$P(BPCX,U,12)="I":"INACTIVE",1:"UNKNOWN"),BPCOSET=$P(BPCX,U,13),BPCNARP=$P(BPCX,U,5),BPCNBR=+$P(BPCX,U,7)
S BPCDTENT=$P(BPCX,U,8),BPCDTMOD=$P(BPCX,U,3),BPCLOCC=$P(^AUTTLOC(BPCLOCP,0),U,7),BPCCLS=$P(BPCX,U,4)
S:BPCLOCC="" BPCLOCC="UK"
S BPCDX=$P(^ICD9(BPCDXP,0),U,1),BPCPRBID=BPCLOCC_BPCNBR,BPCNAR=$P(^AUTNPOV(BPCNARP,0),U,1)
S ^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR)="PROB"_U_BPCPRBID_U_BPCDX_U_BPCSTAT_U_BPCOSET_U_BPCNAR_U_BPCPRB_U_BPCDTENT_U_BPCDTMOD_U_BPCCLS_U_BPCDXP
D GETNOTES
Q
GETNOTES ;
S BPCLOCP="" F S BPCLOCP=$O(^AUPNPROB(BPCPRB,11,"B",BPCLOCP)) Q:BPCLOCP="" S BPCLOCN=$P(^AUTTLOC(BPCLOCP,0),U,7),BPCNUM="" F S BPCNUM=$O(^AUPNPROB(BPCPRB,11,"B",BPCLOCP,BPCNUM)) Q:BPCNUM="" D GN1
Q
GN1 ;
S BPCNOT="0" F S BPCNOT=$O(^AUPNPROB(BPCPRB,11,BPCNUM,11,BPCNOT)) Q:+BPCNOT=0 D GN2
Q
GN2 ;
S BPCNOTID=BPCLOCN_BPCNOT
S BPCX=^AUPNPROB(BPCPRB,11,BPCNUM,11,BPCNOT,0)
S ^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR,BPCNUM,BPCNOT)="NOTE"_U_BPCPRB_U_BPCNUM_U_BPCNOTID_U_BPCLOCP_U_BPCX
S BPCCTR=BPCCTR+1
Q
SETRES ;
I BPCCTR=0 S RESULT(1)=-1,RESULT(2)="NO PROBLEMS FOUND!" Q
S RESULT(1)=BPCCTR,BPCCTR=1
S BPCSTAT="" F S BPCSTAT=$O(^BGUTMP(BPCSUB,BPCSTAT)) Q:BPCSTAT="" D SETRES1
Q
SETRES1 ;
;S BPCPRBID="" F S BPCPRBID=$O(^BGUTMP(BPCSUB,BPCSTAT,BPCPRBID)) Q:BPCPRBID="" S BPCCTR=BPCCTR+1,RESULT(BPCCTR)=^(BPCPRBID) D SETRES2
S BPCLOCC="" F S BPCLOCC=$O(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC)) Q:BPCLOCC="" S BPCNBR="" F S BPCNBR=$O(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR)) Q:BPCNBR="" S BPCCTR=BPCCTR+1,RESULT(BPCCTR)=^(BPCNBR) D SETRES2
Q
SETRES2 ;
S BPCNUM="" F S BPCNUM=$O(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR,BPCNUM)) Q:BPCNUM="" S BPCNOT="" F S BPCNOT=$O(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR,BPCNUM,BPCNOT)) Q:BPCNOT="" S BPCCTR=BPCCTR+1,RESULT(BPCCTR)=^(BPCNOT)
Q
BPCPROB ; IHS/OIT/MJL - GUI COLLECTS PROBLEM LIST DATA ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
EN(RESULT,BPCIEN,BPCSDATE,BPCEDATE) ;EP CALL FROM REMOTE PROC: BPC GETPROBLEMS
+1 SET U="^"
SET XWBWRAP=1
SET BPCCTR=0
SET BPCSUB=$JOB
SET BPCIEN=$GET(BPCIEN)
SET BPCSDATE=$GET(BPCSDATE)
SET BPCEDATE=$GET(BPCEDATE)
KILL ^BGUTMP(BPCSUB),RESULT
+2 IF BPCIEN=""
SET RESULT(1)="-1"
SET RESULT(2)="NO PATIENT IEN DEFINED!"
DO KILL
QUIT
+3 IF BPCSDATE=""
SET RESULT(1)="-1"
SET RESULT(2)="NO STARTING DATE DEFINED!"
DO KILL
QUIT
+4 IF BPCEDATE=""
SET RESULT(1)="-1"
SET RESULT(2)="NO ENDING DATE DEFINED!"
DO KILL
QUIT
+5 DO DT^DILF("",BPCSDATE,.BPCSDAT)
+6 IF BPCSDAT=-1
Begin DoDot:1
+7 SET BPCSDATE="1/1/1980"
+8 DO DT^DILF("",BPCSDATE,.BPCSDAT)
End DoDot:1
+9 DO DT^DILF("",BPCEDATE,.BPCEDAT)
+10 IF BPCEDAT=-1
Begin DoDot:1
+11 SET BPCEDATE="T"
+12 DO DT^DILF("",BPCEDATE,.BPCEDAT)
End DoDot:1
+13 SET BPCPRB=""
FOR
SET BPCPRB=$ORDER(^AUPNPROB("AC",BPCIEN,BPCPRB))
IF BPCPRB=""
QUIT
DO PRB
+14 DO SETRES
DO KILL
+15 QUIT
KILL ;
+1 KILL BPCCTR,BPCSUB,BPCPRB,BPCIEN,BPCCTR,BPCX,BPCDXP,BPCLOCP,BPCSTAT,BPCOSET,BPCNARP,BPCNBR,BPCDX,BPCPRBID,BPCNAR,BPCDTMOD,BPCDTENT,BPCCLS,BPCLOCC,BPCLOCN
+2 QUIT
PRB ;
+1 SET BPCCTR=BPCCTR+1
+2 SET BPCX=^AUPNPROB(BPCPRB,0)
+3 IF $PIECE($GET(BPCX),U,3)<BPCSDATE
QUIT
+4 SET BPCDXP=$PIECE(BPCX,U,1)
SET BPCLOCP=$PIECE(BPCX,U,6)
SET BPCSTAT=$SELECT($PIECE(BPCX,U,12)="A":"ACTIVE",$PIECE(BPCX,U,12)="I":"INACTIVE",1:"UNKNOWN")
SET BPCOSET=$PIECE(BPCX,U,13)
SET BPCNARP=$PIECE(BPCX,U,5)
SET BPCNBR=+$PIECE(BPCX,U,7)
+5 SET BPCDTENT=$PIECE(BPCX,U,8)
SET BPCDTMOD=$PIECE(BPCX,U,3)
SET BPCLOCC=$PIECE(^AUTTLOC(BPCLOCP,0),U,7)
SET BPCCLS=$PIECE(BPCX,U,4)
+6 IF BPCLOCC=""
SET BPCLOCC="UK"
+7 SET BPCDX=$PIECE(^ICD9(BPCDXP,0),U,1)
SET BPCPRBID=BPCLOCC_BPCNBR
SET BPCNAR=$PIECE(^AUTNPOV(BPCNARP,0),U,1)
+8 SET ^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR)="PROB"_U_BPCPRBID_U_BPCDX_U_BPCSTAT_U_BPCOSET_U_BPCNAR_U_BPCPRB_U_BPCDTENT_U_BPCDTMOD_U_BPCCLS_U_BPCDXP
+9 DO GETNOTES
+10 QUIT
GETNOTES ;
+1 SET BPCLOCP=""
FOR
SET BPCLOCP=$ORDER(^AUPNPROB(BPCPRB,11,"B",BPCLOCP))
IF BPCLOCP=""
QUIT
SET BPCLOCN=$PIECE(^AUTTLOC(BPCLOCP,0),U,7)
SET BPCNUM=""
FOR
SET BPCNUM=$ORDER(^AUPNPROB(BPCPRB,11,"B",BPCLOCP,BPCNUM))
IF BPCNUM=""
QUIT
DO GN1
+2 QUIT
GN1 ;
+1 SET BPCNOT="0"
FOR
SET BPCNOT=$ORDER(^AUPNPROB(BPCPRB,11,BPCNUM,11,BPCNOT))
IF +BPCNOT=0
QUIT
DO GN2
+2 QUIT
GN2 ;
+1 SET BPCNOTID=BPCLOCN_BPCNOT
+2 SET BPCX=^AUPNPROB(BPCPRB,11,BPCNUM,11,BPCNOT,0)
+3 SET ^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR,BPCNUM,BPCNOT)="NOTE"_U_BPCPRB_U_BPCNUM_U_BPCNOTID_U_BPCLOCP_U_BPCX
+4 SET BPCCTR=BPCCTR+1
+5 QUIT
SETRES ;
+1 IF BPCCTR=0
SET RESULT(1)=-1
SET RESULT(2)="NO PROBLEMS FOUND!"
QUIT
+2 SET RESULT(1)=BPCCTR
SET BPCCTR=1
+3 SET BPCSTAT=""
FOR
SET BPCSTAT=$ORDER(^BGUTMP(BPCSUB,BPCSTAT))
IF BPCSTAT=""
QUIT
DO SETRES1
+4 QUIT
SETRES1 ;
+1 ;S BPCPRBID="" F S BPCPRBID=$O(^BGUTMP(BPCSUB,BPCSTAT,BPCPRBID)) Q:BPCPRBID="" S BPCCTR=BPCCTR+1,RESULT(BPCCTR)=^(BPCPRBID) D SETRES2
+2 SET BPCLOCC=""
FOR
SET BPCLOCC=$ORDER(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC))
IF BPCLOCC=""
QUIT
SET BPCNBR=""
FOR
SET BPCNBR=$ORDER(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR))
IF BPCNBR=""
QUIT
SET BPCCTR=BPCCTR+1
SET RESULT(BPCCTR)=^(BPCNBR)
DO SETRES2
+3 QUIT
SETRES2 ;
+1 SET BPCNUM=""
FOR
SET BPCNUM=$ORDER(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR,BPCNUM))
IF BPCNUM=""
QUIT
SET BPCNOT=""
FOR
SET BPCNOT=$ORDER(^BGUTMP(BPCSUB,BPCSTAT,BPCLOCC,BPCNBR,BPCNUM,BPCNOT))
IF BPCNOT=""
QUIT
SET BPCCTR=BPCCTR+1
SET RESULT(BPCCTR)=^(BPCNOT)
+2 QUIT
