BQIPTREV ;APTIV/HC/ALA-Get Patient's Last Routine Events ; 18 Jan 2008 5:49 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
;
EN(DATA,DFN) ;EP - BQI GET PATIENT ROUTINE EVENTS
;Description - all the routine events that a patient has
;
;Input
; DFN - Patient internal entry number
;
NEW UID,II,BQNM,IEN,BQEVNT,HIEN,CALL,TAG,CODE,BQREM,RIEN,BQIX,BQLDT,CAT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTREV",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTREV D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00050LASTROUT^D00015LASTDATE^T00030CATEGORY^I00010VISIT_IEN"
S @DATA@(II)=HDR_$C(30)
S BQNM=""
F S BQNM=$O(^BQI(90507.3,"B",BQNM)) Q:BQNM="" D
. S IEN=""
. F S IEN=$O(^BQI(90507.3,"B",BQNM,IEN)) Q:IEN="" D
.. S BQEVNT=$P(^BQI(90507.3,IEN,0),U,1),BQREM=$P(^(0),U,2)
.. S HIEN=$$FIND1^DIC(9001018,"","X",BQREM,"B","","ERROR")
.. ; if it didn't find the corresponding reminder, quit
.. I HIEN=0 Q
.. I $P(^APCHSURV(HIEN,0),U,3)'=1 Q
.. S CALL=$P(^APCHSURV(HIEN,0),U,2),TAG=$P(CALL,";",1)
.. S CAT=$$GET1^DIQ(9001018,HIEN_",",.05,"E")
.. I TAG="" Q
.. S CODE=TAG_"_"_HIEN
.. S RIEN=$O(^BQIPAT(DFN,40,"B",CODE,""))
.. I RIEN="" Q
.. S BQIX=^BQIPAT(DFN,40,RIEN,0)
.. S CT=0 F BI=2:1:3 I $P(BQIX,U,BI)'="" S CT=CT+1
.. I CT=0 Q
.. S BQLDT=$P(BQIX,U,2),VISIT=$P(BQIX,U,6)
.. ;
.. I BQREM="COLORECTAL CA-SCOPE/XRAY" D
... S BQLDT=""
... S X=$$GVHMR^APCHSMU(DFN,HIEN)
... I X'["|" S BQVAL=$P(X,U,4) D Q
.... I BQVAL'[$$UP^XLFSTR(BQEVNT) Q
.... S BQLDT=$P(X,U,2),VISIT=$P(X,U,6)
... F BQJ=1:1:$L(X,"|") D
.... S BQVAL=$P(X,"|",BQJ)
.... I $P(BQVAL,U,1)'=$$UP^XLFSTR(BQEVNT) Q
.... S BQLDT=$P(BQVAL,U,2),VISIT=$P(BQIX,U,6)
.. S BQLDT=$$FMTE^BQIUL1(BQLDT)
.. ;I BQLDT="" S BQLDT="01/01/0001 12:00:00 AM"
.. S II=II+1,@DATA@(II)=BQEVNT_U_BQLDT_U_CAT_U_VISIT_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
BQIPTREV ;APTIV/HC/ALA-Get Patient's Last Routine Events ; 18 Jan 2008 5:49 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;
EN(DATA,DFN) ;EP - BQI GET PATIENT ROUTINE EVENTS
+1 ;Description - all the routine events that a patient has
+2 ;
+3 ;Input
+4 ; DFN - Patient internal entry number
+5 ;
+6 NEW UID,II,BQNM,IEN,BQEVNT,HIEN,CALL,TAG,CODE,BQREM,RIEN,BQIX,BQLDT,CAT
+7 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+8 SET DATA=$NAME(^TMP("BQIPTREV",UID))
+9 KILL @DATA
+10 ;
+11 SET II=0
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTREV D UNWIND^%ZTER"
+13 ;
+14 SET HDR="T00050LASTROUT^D00015LASTDATE^T00030CATEGORY^I00010VISIT_IEN"
+15 SET @DATA@(II)=HDR_$CHAR(30)
+16 SET BQNM=""
+17 FOR
SET BQNM=$ORDER(^BQI(90507.3,"B",BQNM))
IF BQNM=""
QUIT
Begin DoDot:1
+18 SET IEN=""
+19 FOR
SET IEN=$ORDER(^BQI(90507.3,"B",BQNM,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+20 SET BQEVNT=$PIECE(^BQI(90507.3,IEN,0),U,1)
SET BQREM=$PIECE(^(0),U,2)
+21 SET HIEN=$$FIND1^DIC(9001018,"","X",BQREM,"B","","ERROR")
+22 ; if it didn't find the corresponding reminder, quit
+23 IF HIEN=0
QUIT
+24 IF $PIECE(^APCHSURV(HIEN,0),U,3)'=1
QUIT
+25 SET CALL=$PIECE(^APCHSURV(HIEN,0),U,2)
SET TAG=$PIECE(CALL,";",1)
+26 SET CAT=$$GET1^DIQ(9001018,HIEN_",",.05,"E")
+27 IF TAG=""
QUIT
+28 SET CODE=TAG_"_"_HIEN
+29 SET RIEN=$ORDER(^BQIPAT(DFN,40,"B",CODE,""))
+30 IF RIEN=""
QUIT
+31 SET BQIX=^BQIPAT(DFN,40,RIEN,0)
+32 SET CT=0
FOR BI=2:1:3
IF $PIECE(BQIX,U,BI)'=""
SET CT=CT+1
+33 IF CT=0
QUIT
+34 SET BQLDT=$PIECE(BQIX,U,2)
SET VISIT=$PIECE(BQIX,U,6)
+35 ;
+36 IF BQREM="COLORECTAL CA-SCOPE/XRAY"
Begin DoDot:3
+37 SET BQLDT=""
+38 SET X=$$GVHMR^APCHSMU(DFN,HIEN)
+39 IF X'["|"
SET BQVAL=$PIECE(X,U,4)
Begin DoDot:4
+40 IF BQVAL'[$$UP^XLFSTR(BQEVNT)
QUIT
+41 SET BQLDT=$PIECE(X,U,2)
SET VISIT=$PIECE(X,U,6)
End DoDot:4
QUIT
+42 FOR BQJ=1:1:$LENGTH(X,"|")
Begin DoDot:4
+43 SET BQVAL=$PIECE(X,"|",BQJ)
+44 IF $PIECE(BQVAL,U,1)'=$$UP^XLFSTR(BQEVNT)
QUIT
+45 SET BQLDT=$PIECE(BQVAL,U,2)
SET VISIT=$PIECE(BQIX,U,6)
End DoDot:4
End DoDot:3
+46 SET BQLDT=$$FMTE^BQIUL1(BQLDT)
+47 ;I BQLDT="" S BQLDT="01/01/0001 12:00:00 AM"
+48 SET II=II+1
SET @DATA@(II)=BQEVNT_U_BQLDT_U_CAT_U_VISIT_$CHAR(30)
End DoDot:2
End DoDot:1
+49 ;
+50 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+51 QUIT
+52 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
