BTPWPUTL ;VNGT/HS/ALA-Event Utility Program ; 21 Aug 2009 10:26 AM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
FDUE() ; EP - Findings Due By Timeframe
NEW VALUE
S VALUE=$$GET1^DIQ(90628,"1,",1.01,"E")
D SYS
Q VALUE
;
FLDUE(EVNT,FNDT,TRIEN,TMFRAME) ;EP - Followup Due By Timeframe
; Input
; EVNT - Event type IEN
; FNDT - Findings Date
; TRIEN - Tracked IEN
; TMFRAME - Timeframe
;
NEW VALUE,IEN,FLDUE
S EVNT=$G(EVNT,""),FNDT=$G(FNDT,""),TRIEN=$G(TRIEN,""),TMFRAME=$G(TMFRAME,"")
S VALUE=$$GET1^DIQ(90628,"1,",1.02,"E") D SYS
;
; if finding date not input but tracked ien is, get it from tracked event
I $G(FNDT)="",$G(TRIEN)'="" D
. S FNDT=$O(^BTPWP(TRIEN,10,"B",""),-1) I FNDT'="" S FNDT=FNDT\1
;
; if event passed in, get Followup Due By based on event type
I $G(EVNT)'="",$G(TMFRAME)="" D
. S IEN=$O(^BTPW(90628,1,2,"B",EVNT,"")) I IEN="" Q
. S TMFRAME=$P($G(^BTPW(90628,1,2,IEN,0)),U,2)
;
S TMFRAME=$S(TMFRAME="24M":730,TMFRAME="36M":1095,1:365)
;
S FLDUE=$$FMADD^XLFDT(FNDT,TMFRAME)
Q FLDUE
;
DFDUE(TRIEN,TMFRAME) ; EP - Get Findings Due By Date
; Input
; TRIEN - Tracked record IEN
; TMFRAME - Timeframe for findings due by date
;
NEW EVTDT,FDUE
S TMFRAME=$G(TMFRAME,"")
S EVTDT=$P(^BTPWQ(TRIEN,0),U,3)
I TMFRAME'="" S VALUE=TMFRAME D SYS S TMFRAME=VALUE
I TMFRAME="" S TMFRAME=$$FDUE()
S FDUE=$$FMADD^XLFDT(EVTDT,TMFRAME)
I FDUE<DT S FDUE=DT
Q FDUE
;
NTDUE(TRIEN,TMFRAME) ; EP - Get Notification Due By Date
; Input
; TRIEN - Tracked record IEN
; TMFRAME - Timeframe for notification date
NEW NDUE,FOLDT
S TMFRAME=$G(TMFRAME,"")
; if timeframe is not passed in get default value from site parameters
I TMFRAME="" D
. S VALUE=$$GET1^DIQ(90628,"1,",1.03,"E") D SYS
. S TMFRAME=VALUE
;
; notification date is based on the date the Follow-up recommendation is entered
S FOLDT=$O(^BTPWP(TRIEN,12,"B",""),-1)
S NDUE=$$FMADD^XLFDT(FOLDT,TMFRAME)
I NDUE<DT S NDUE=DT
Q NDUE
;
GET(DATA,EVTDT) ;EP -- BTPW GET FINDINGS DUE BY
NEW UID,II,FDUE,TMFRAME
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWFDUE",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWSCHD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
;Convert Date to Internal Value
S EVTDT=$$DATE^BQIUL1(EVTDT)
;
S @DATA@(II)="D00015FIND_DUEBY"_$C(30)
S TMFRAME=$$FDUE()
S FDUE=$$FMADD^XLFDT(EVTDT,TMFRAME)
I FDUE<DT S FDUE=DT
S II=II+1,@DATA@(II)=$$FMTE^BQIUL1(FDUE)_$C(30)
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
SYS ;EP
I VALUE="" S VALUE=7
I VALUE["M" D
. I VALUE="1M" S VALUE=30 Q
. I VALUE="2M" S VALUE=60
Q
;
PFIN(PROCN,RESULT) ;EP - Get findings
; Input
; PROCN - Procedure IEN
; Return RESULT array
;
NEW IEN,II,FIIEN,FIND,INTRP
S IEN=0,II=0
F S IEN=$O(^BTPW(90621,PROCN,6,IEN)) Q:'IEN D
. S FIIEN=$P(^BTPW(90621,PROCN,6,IEN,0),U,1)
. NEW DA,IENS
. S DA(1)=PROCN,DA=IEN,IENS=$$IENS^DILF(.DA)
. S FIND=$$GET1^DIQ(90621.06,IENS,.01,"E")
. S INTRP=$$GET1^DIQ(90621.06,IENS,.02,"E")
. S II=II+1,RESULT(II)=FIIEN_U_FIND_U_INTRP
Q
BTPWPUTL ;VNGT/HS/ALA-Event Utility Program ; 21 Aug 2009 10:26 AM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
FDUE() ; EP - Findings Due By Timeframe
+1 NEW VALUE
+2 SET VALUE=$$GET1^DIQ(90628,"1,",1.01,"E")
+3 DO SYS
+4 QUIT VALUE
+5 ;
FLDUE(EVNT,FNDT,TRIEN,TMFRAME) ;EP - Followup Due By Timeframe
+1 ; Input
+2 ; EVNT - Event type IEN
+3 ; FNDT - Findings Date
+4 ; TRIEN - Tracked IEN
+5 ; TMFRAME - Timeframe
+6 ;
+7 NEW VALUE,IEN,FLDUE
+8 SET EVNT=$GET(EVNT,"")
SET FNDT=$GET(FNDT,"")
SET TRIEN=$GET(TRIEN,"")
SET TMFRAME=$GET(TMFRAME,"")
+9 SET VALUE=$$GET1^DIQ(90628,"1,",1.02,"E")
DO SYS
+10 ;
+11 ; if finding date not input but tracked ien is, get it from tracked event
+12 IF $GET(FNDT)=""
IF $GET(TRIEN)'=""
Begin DoDot:1
+13 SET FNDT=$ORDER(^BTPWP(TRIEN,10,"B",""),-1)
IF FNDT'=""
SET FNDT=FNDT\1
End DoDot:1
+14 ;
+15 ; if event passed in, get Followup Due By based on event type
+16 IF $GET(EVNT)'=""
IF $GET(TMFRAME)=""
Begin DoDot:1
+17 SET IEN=$ORDER(^BTPW(90628,1,2,"B",EVNT,""))
IF IEN=""
QUIT
+18 SET TMFRAME=$PIECE($GET(^BTPW(90628,1,2,IEN,0)),U,2)
End DoDot:1
+19 ;
+20 SET TMFRAME=$SELECT(TMFRAME="24M":730,TMFRAME="36M":1095,1:365)
+21 ;
+22 SET FLDUE=$$FMADD^XLFDT(FNDT,TMFRAME)
+23 QUIT FLDUE
+24 ;
DFDUE(TRIEN,TMFRAME) ; EP - Get Findings Due By Date
+1 ; Input
+2 ; TRIEN - Tracked record IEN
+3 ; TMFRAME - Timeframe for findings due by date
+4 ;
+5 NEW EVTDT,FDUE
+6 SET TMFRAME=$GET(TMFRAME,"")
+7 SET EVTDT=$PIECE(^BTPWQ(TRIEN,0),U,3)
+8 IF TMFRAME'=""
SET VALUE=TMFRAME
DO SYS
SET TMFRAME=VALUE
+9 IF TMFRAME=""
SET TMFRAME=$$FDUE()
+10 SET FDUE=$$FMADD^XLFDT(EVTDT,TMFRAME)
+11 IF FDUE<DT
SET FDUE=DT
+12 QUIT FDUE
+13 ;
NTDUE(TRIEN,TMFRAME) ; EP - Get Notification Due By Date
+1 ; Input
+2 ; TRIEN - Tracked record IEN
+3 ; TMFRAME - Timeframe for notification date
+4 NEW NDUE,FOLDT
+5 SET TMFRAME=$GET(TMFRAME,"")
+6 ; if timeframe is not passed in get default value from site parameters
+7 IF TMFRAME=""
Begin DoDot:1
+8 SET VALUE=$$GET1^DIQ(90628,"1,",1.03,"E")
DO SYS
+9 SET TMFRAME=VALUE
End DoDot:1
+10 ;
+11 ; notification date is based on the date the Follow-up recommendation is entered
+12 SET FOLDT=$ORDER(^BTPWP(TRIEN,12,"B",""),-1)
+13 SET NDUE=$$FMADD^XLFDT(FOLDT,TMFRAME)
+14 IF NDUE<DT
SET NDUE=DT
+15 QUIT NDUE
+16 ;
GET(DATA,EVTDT) ;EP -- BTPW GET FINDINGS DUE BY
+1 NEW UID,II,FDUE,TMFRAME
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BTPWFDUE",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWSCHD D UNWIND^%ZTER"
+8 ;
+9 ;Convert Date to Internal Value
+10 SET EVTDT=$$DATE^BQIUL1(EVTDT)
+11 ;
+12 SET @DATA@(II)="D00015FIND_DUEBY"_$CHAR(30)
+13 SET TMFRAME=$$FDUE()
+14 SET FDUE=$$FMADD^XLFDT(EVTDT,TMFRAME)
+15 IF FDUE<DT
SET FDUE=DT
+16 SET II=II+1
SET @DATA@(II)=$$FMTE^BQIUL1(FDUE)_$CHAR(30)
+17 ;
+18 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+19 QUIT
+20 ;
SYS ;EP
+1 IF VALUE=""
SET VALUE=7
+2 IF VALUE["M"
Begin DoDot:1
+3 IF VALUE="1M"
SET VALUE=30
QUIT
+4 IF VALUE="2M"
SET VALUE=60
End DoDot:1
+5 QUIT
+6 ;
PFIN(PROCN,RESULT) ;EP - Get findings
+1 ; Input
+2 ; PROCN - Procedure IEN
+3 ; Return RESULT array
+4 ;
+5 NEW IEN,II,FIIEN,FIND,INTRP
+6 SET IEN=0
SET II=0
+7 FOR
SET IEN=$ORDER(^BTPW(90621,PROCN,6,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+8 SET FIIEN=$PIECE(^BTPW(90621,PROCN,6,IEN,0),U,1)
+9 NEW DA,IENS
+10 SET DA(1)=PROCN
SET DA=IEN
SET IENS=$$IENS^DILF(.DA)
+11 SET FIND=$$GET1^DIQ(90621.06,IENS,.01,"E")
+12 SET INTRP=$$GET1^DIQ(90621.06,IENS,.02,"E")
+13 SET II=II+1
SET RESULT(II)=FIIEN_U_FIND_U_INTRP
End DoDot:1
+14 QUIT
