- 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
