BTPWRMDR ;VNGT/HS/ALA-CMET Reminders ; 13 Nov 2009 1:49 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;**2**;Feb 07, 2011;Build 52
;
;
PAT(DATA,DFN) ; EP -- BTPW GET CMET REMINDERS BY PAT
; Input
; DFN - Patient internal entry number
;
NEW UID,II,ERROR,BQIDFN,EVT,EVDT,CMIEN,EVNAM,LAST,CODE,EVDATE,LSTN,LSUPD,QFL,VISIT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWRMDR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWRMDR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S BQIDFN=$G(DFN,"")
I BQIDFN="" S BMXSEC="No patient selected" Q
;
S EVT=""
F S EVT=$O(^BTPWP("AG",BQIDFN,EVT)) Q:EVT="" D
. S EVDT="",QFL=0
. F S EVDT=$O(^BTPWP("AG",BQIDFN,EVT,EVDT),-1) Q:EVDT="" D Q:QFL
.. S CMIEN=""
.. F S CMIEN=$O(^BTPWP("AG",BQIDFN,EVT,EVDT,CMIEN)) Q:CMIEN="" D Q:QFL
... S EVNAM=$P(^BTPW(90621,EVT,0),U,1),LAST="",VISIT=""
... S LSUPD=$P($G(^BTPWP(CMIEN,1)),U,2)\1
... S LSTN=$P(^BTPWP(CMIEN,0),U,11) I LSTN'="" D
.... I $P(^BTPWP(LSTN,0),U,1)=EVT S LAST=$P($G(^BTPWP(LSTN,0)),U,3),VISIT=$P(^(0),U,4) Q
... I LAST="" D
.... S LAST=$O(^XTMP("BTPWPRC",BQIDFN,EVT,""),-1) I LAST="" Q
.... S PRI=""
.... F S PRI=$O(^XTMP("BTPWPRC",BQIDFN,EVT,LAST,PRI)) Q:PRI="" D
..... S VIS=""
..... F S VIS=$O(^XTMP("BTPWPRC",BQIDFN,EVT,LAST,PRI,VIS)) Q:VIS="" I VIS'="~" S VISIT=VIS Q
... S CODE="CMET_"_EVT,EVDATE=EVDT\1,QFL=1
... S II=II+1,@DATA@(II)="CMET^"_$$CAT^BTPWPDSP(EVT)_U_CODE_U_EVNAM_U_$$FMTE^BQIUL1(LAST)_U
... S @DATA@(II)=@DATA@(II)_$$FMTE^BQIUL1(EVDATE)_U_$$FMTE^BQIUL1(EVDATE)_U_$$FMTE^BQIUL1(LSUPD)_U_VISIT_U_$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)="-1"_$C(30)
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ; Header
S @DATA@(II)="T00030CATEGORY^T00030CLIN_GROUP^T00015REM_CODE^T00050REM_DESC^D00010REM_LAST^"
S @DATA@(II)=@DATA@(II)_"T00040REM_NEXT^D00010REM_DUE^D00030LAST_UPDATED^I00010VISIT_IEN^I00003DISPLAY_ORDER"_$C(30)
Q
;
REC(BQIDFN,DATA) ; PEP - Get future CMET records for a patient
; Input
; BQIDFN - Patient IEN
; DATA - Target
; Output
; Identifier^Category^Event Name^Next Event Due
;
NEW EVT,EVDT,QFL,CMIEN,EVNAM,LAST,EVDUE,II
K @DATA
S EVT="",II=0
F S EVT=$O(^BTPWP("AG",BQIDFN,EVT)) Q:EVT="" D
. S EVDT="",QFL=0
. F S EVDT=$O(^BTPWP("AG",BQIDFN,EVT,EVDT),-1) Q:EVDT="" D Q:QFL
.. S CMIEN=""
.. F S CMIEN=$O(^BTPWP("AG",BQIDFN,EVT,EVDT,CMIEN)) Q:CMIEN="" D Q:QFL
... S EVNAM=$P(^BTPW(90621,EVT,0),U,1),LAST=$$FMTE^BQIUL1($P($G(^BTPW(90621,EVT,1)),U,2)),QFL=1
... S EVDUE=EVDT\1
... S II=II+1,@DATA@(II)="CMET^"_$$CAT^BTPWPDSP(EVT)_U_EVNAM_U_$$FMTE^BQIUL1(EVDUE)
Q
;
EVT(BQIDFN,EVNT,SYS) ; PEP
; Input
; BQIDFN - Patient IEN
; EVNT - CMET Event IEN
; SYS - '1' = EHR
; Output
; Result - -1 is an error,1 is the most recent event due, 0 is none found
; If SYS is EHR (1) then Last Event Date^Date Next Due
; If SYS is not EHR (0) then Category^Event Code^Event Name^Last Event Date^Next Event Due^next event due fileman^Last Updated Date^Event Visit IEN
;
;
NEW EVDT,CMIEN,EVNAM,LAST,VISIT,LSUPD,LSTN,PRI,VIS,CODE,RESULT,EVDUE
S SYS=$G(SYS,0)
I EVNT'?.N S EVNT=$O(^BTPW(90621,"B",EVNT,""))
I EVNT="" Q "-1"
S EVDT="",LAST="",RESULT=0
F S EVDT=$O(^BTPWP("AG",BQIDFN,EVNT,EVDT),-1) Q:EVDT="" D
. S CMIEN=""
. F S CMIEN=$O(^BTPWP("AG",BQIDFN,EVNT,EVDT,CMIEN)) Q:CMIEN="" D
.. S EVNAM=$P(^BTPW(90621,EVNT,0),U,1),LAST="",VISIT=""
.. S LSUPD=$P($G(^BTPWP(CMIEN,1)),U,2)\1
.. S LSTN=$P(^BTPWP(CMIEN,0),U,11) I LSTN'="" D
... I $P(^BTPWP(LSTN,0),U,1)=EVNT S LAST=$P($G(^BTPWP(LSTN,0)),U,3),VISIT=$P(^(0),U,4) Q
.. I LAST="" D
... S LAST=$O(^XTMP("BTPWPRC",BQIDFN,EVNT,""),-1) I LAST="" Q
... S PRI=""
... F S PRI=$O(^XTMP("BTPWPRC",BQIDFN,EVNT,LAST,PRI)) Q:PRI="" D
.... S VIS=""
.... F S VIS=$O(^XTMP("BTPWPRC",BQIDFN,EVNT,LAST,PRI,VIS)) Q:VIS="" I VIS'="~" S VISIT=VIS Q
.. S EVDUE=EVDT\1
;
S CODE="CMET_"_EVNT
I 'SYS D
. I $G(EVNAM)="" S RESULT=0 Q
. S RESULT="1^"_$$CAT^BTPWPDSP(EVNT)_U_CODE_U_EVNAM_U_$$FMTE^BQIUL1(LAST)_U
. S RESULT=RESULT_$$FMTE^BQIUL1(EVDUE)_U_EVDUE_U_$$FMTE^BQIUL1(LSUPD)_U_VISIT_U
I SYS D
. I $G(EVNAM)="" S RESULT=0 Q
. S RESULT=1_U_$$FMTE^BQIUL1(LAST)_U_$$FMTE^BQIUL1(EVDUE)
Q RESULT
BTPWRMDR ;VNGT/HS/ALA-CMET Reminders ; 13 Nov 2009 1:49 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;**2**;Feb 07, 2011;Build 52
+2 ;
+3 ;
PAT(DATA,DFN) ; EP -- BTPW GET CMET REMINDERS BY PAT
+1 ; Input
+2 ; DFN - Patient internal entry number
+3 ;
+4 NEW UID,II,ERROR,BQIDFN,EVT,EVDT,CMIEN,EVNAM,LAST,CODE,EVDATE,LSTN,LSUPD,QFL,VISIT
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET DATA=$NAME(^TMP("BTPWRMDR",UID))
+7 KILL @DATA
+8 ;
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWRMDR D UNWIND^%ZTER"
+11 DO HDR
+12 SET BQIDFN=$GET(DFN,"")
+13 IF BQIDFN=""
SET BMXSEC="No patient selected"
QUIT
+14 ;
+15 SET EVT=""
+16 FOR
SET EVT=$ORDER(^BTPWP("AG",BQIDFN,EVT))
IF EVT=""
QUIT
Begin DoDot:1
+17 SET EVDT=""
SET QFL=0
+18 FOR
SET EVDT=$ORDER(^BTPWP("AG",BQIDFN,EVT,EVDT),-1)
IF EVDT=""
QUIT
Begin DoDot:2
+19 SET CMIEN=""
+20 FOR
SET CMIEN=$ORDER(^BTPWP("AG",BQIDFN,EVT,EVDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:3
+21 SET EVNAM=$PIECE(^BTPW(90621,EVT,0),U,1)
SET LAST=""
SET VISIT=""
+22 SET LSUPD=$PIECE($GET(^BTPWP(CMIEN,1)),U,2)\1
+23 SET LSTN=$PIECE(^BTPWP(CMIEN,0),U,11)
IF LSTN'=""
Begin DoDot:4
+24 IF $PIECE(^BTPWP(LSTN,0),U,1)=EVT
SET LAST=$PIECE($GET(^BTPWP(LSTN,0)),U,3)
SET VISIT=$PIECE(^(0),U,4)
QUIT
End DoDot:4
+25 IF LAST=""
Begin DoDot:4
+26 SET LAST=$ORDER(^XTMP("BTPWPRC",BQIDFN,EVT,""),-1)
IF LAST=""
QUIT
+27 SET PRI=""
+28 FOR
SET PRI=$ORDER(^XTMP("BTPWPRC",BQIDFN,EVT,LAST,PRI))
IF PRI=""
QUIT
Begin DoDot:5
+29 SET VIS=""
+30 FOR
SET VIS=$ORDER(^XTMP("BTPWPRC",BQIDFN,EVT,LAST,PRI,VIS))
IF VIS=""
QUIT
IF VIS'="~"
SET VISIT=VIS
QUIT
End DoDot:5
End DoDot:4
+31 SET CODE="CMET_"_EVT
SET EVDATE=EVDT\1
SET QFL=1
+32 SET II=II+1
SET @DATA@(II)="CMET^"_$$CAT^BTPWPDSP(EVT)_U_CODE_U_EVNAM_U_$$FMTE^BQIUL1(LAST)_U
+33 SET @DATA@(II)=@DATA@(II)_$$FMTE^BQIUL1(EVDATE)_U_$$FMTE^BQIUL1(EVDATE)_U_$$FMTE^BQIUL1(LSUPD)_U_VISIT_U_$CHAR(30)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+34 ;
+35 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+36 QUIT
+37 ;
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)="-1"_$CHAR(30)
+6 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+7 QUIT
+8 ;
HDR ; Header
+1 SET @DATA@(II)="T00030CATEGORY^T00030CLIN_GROUP^T00015REM_CODE^T00050REM_DESC^D00010REM_LAST^"
+2 SET @DATA@(II)=@DATA@(II)_"T00040REM_NEXT^D00010REM_DUE^D00030LAST_UPDATED^I00010VISIT_IEN^I00003DISPLAY_ORDER"_$CHAR(30)
+3 QUIT
+4 ;
REC(BQIDFN,DATA) ; PEP - Get future CMET records for a patient
+1 ; Input
+2 ; BQIDFN - Patient IEN
+3 ; DATA - Target
+4 ; Output
+5 ; Identifier^Category^Event Name^Next Event Due
+6 ;
+7 NEW EVT,EVDT,QFL,CMIEN,EVNAM,LAST,EVDUE,II
+8 KILL @DATA
+9 SET EVT=""
SET II=0
+10 FOR
SET EVT=$ORDER(^BTPWP("AG",BQIDFN,EVT))
IF EVT=""
QUIT
Begin DoDot:1
+11 SET EVDT=""
SET QFL=0
+12 FOR
SET EVDT=$ORDER(^BTPWP("AG",BQIDFN,EVT,EVDT),-1)
IF EVDT=""
QUIT
Begin DoDot:2
+13 SET CMIEN=""
+14 FOR
SET CMIEN=$ORDER(^BTPWP("AG",BQIDFN,EVT,EVDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:3
+15 SET EVNAM=$PIECE(^BTPW(90621,EVT,0),U,1)
SET LAST=$$FMTE^BQIUL1($PIECE($GET(^BTPW(90621,EVT,1)),U,2))
SET QFL=1
+16 SET EVDUE=EVDT\1
+17 SET II=II+1
SET @DATA@(II)="CMET^"_$$CAT^BTPWPDSP(EVT)_U_EVNAM_U_$$FMTE^BQIUL1(EVDUE)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+18 QUIT
+19 ;
EVT(BQIDFN,EVNT,SYS) ; PEP
+1 ; Input
+2 ; BQIDFN - Patient IEN
+3 ; EVNT - CMET Event IEN
+4 ; SYS - '1' = EHR
+5 ; Output
+6 ; Result - -1 is an error,1 is the most recent event due, 0 is none found
+7 ; If SYS is EHR (1) then Last Event Date^Date Next Due
+8 ; If SYS is not EHR (0) then Category^Event Code^Event Name^Last Event Date^Next Event Due^next event due fileman^Last Updated Date^Event Visit IEN
+9 ;
+10 ;
+11 NEW EVDT,CMIEN,EVNAM,LAST,VISIT,LSUPD,LSTN,PRI,VIS,CODE,RESULT,EVDUE
+12 SET SYS=$GET(SYS,0)
+13 IF EVNT'?.N
SET EVNT=$ORDER(^BTPW(90621,"B",EVNT,""))
+14 IF EVNT=""
QUIT "-1"
+15 SET EVDT=""
SET LAST=""
SET RESULT=0
+16 FOR
SET EVDT=$ORDER(^BTPWP("AG",BQIDFN,EVNT,EVDT),-1)
IF EVDT=""
QUIT
Begin DoDot:1
+17 SET CMIEN=""
+18 FOR
SET CMIEN=$ORDER(^BTPWP("AG",BQIDFN,EVNT,EVDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:2
+19 SET EVNAM=$PIECE(^BTPW(90621,EVNT,0),U,1)
SET LAST=""
SET VISIT=""
+20 SET LSUPD=$PIECE($GET(^BTPWP(CMIEN,1)),U,2)\1
+21 SET LSTN=$PIECE(^BTPWP(CMIEN,0),U,11)
IF LSTN'=""
Begin DoDot:3
+22 IF $PIECE(^BTPWP(LSTN,0),U,1)=EVNT
SET LAST=$PIECE($GET(^BTPWP(LSTN,0)),U,3)
SET VISIT=$PIECE(^(0),U,4)
QUIT
End DoDot:3
+23 IF LAST=""
Begin DoDot:3
+24 SET LAST=$ORDER(^XTMP("BTPWPRC",BQIDFN,EVNT,""),-1)
IF LAST=""
QUIT
+25 SET PRI=""
+26 FOR
SET PRI=$ORDER(^XTMP("BTPWPRC",BQIDFN,EVNT,LAST,PRI))
IF PRI=""
QUIT
Begin DoDot:4
+27 SET VIS=""
+28 FOR
SET VIS=$ORDER(^XTMP("BTPWPRC",BQIDFN,EVNT,LAST,PRI,VIS))
IF VIS=""
QUIT
IF VIS'="~"
SET VISIT=VIS
QUIT
End DoDot:4
End DoDot:3
+29 SET EVDUE=EVDT\1
End DoDot:2
End DoDot:1
+30 ;
+31 SET CODE="CMET_"_EVNT
+32 IF 'SYS
Begin DoDot:1
+33 IF $GET(EVNAM)=""
SET RESULT=0
QUIT
+34 SET RESULT="1^"_$$CAT^BTPWPDSP(EVNT)_U_CODE_U_EVNAM_U_$$FMTE^BQIUL1(LAST)_U
+35 SET RESULT=RESULT_$$FMTE^BQIUL1(EVDUE)_U_EVDUE_U_$$FMTE^BQIUL1(LSUPD)_U_VISIT_U
End DoDot:1
+36 IF SYS
Begin DoDot:1
+37 IF $GET(EVNAM)=""
SET RESULT=0
QUIT
+38 SET RESULT=1_U_$$FMTE^BQIUL1(LAST)_U_$$FMTE^BQIUL1(EVDUE)
End DoDot:1
+39 QUIT RESULT
