- 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
