BDGSPT1 ; IHS/OIT/LJF - DISPLAY PATIENTS ACCESSED BY A USER
;;5.3;PIMS;**1005,1007**;MAY 28,2004
;IHS/OIT/LJF 01/20/2006 PATCH 1005 Added this routine
;
NEW BDGUSR,BDGBD,BDGED,SCREEN,BDGSORT
S SCREEN="I $P(^VA(200,+Y,0),U,11)="""""
;S BDGUSR=+$$READ^BDGF("PO^200:EMQZ","Select USER",,SCREEN) Q:BDGUSR<1 cmi/anch/maw 8/23/2007 orig line PATCH 1007
S BDGUSR=+$$READ^BDGF("PO^200:EMQZ","Select USER",,,SCREEN) Q:BDGUSR<1 ;cmi/anch/maw 8/23/2007 mod per linda fels PATCH 1007
S BDGBD=$$READ^BDGF("DO^::EPX","Select EARLIEST DATE") Q:'BDGBD
S BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":EX","Select LATEST DATE") Q:'BDGED
S BDGSORT=$$READ^BDGF("SO^1:BY DATE;2:BY PATIENT NAME;3:BY OPTION","Select How You Want the Report SORTED")
;
EN ; -- main entry point for BDG SECURITY USER LIST
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG SECURITY USER LIST")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S X=$$GET1^DIQ(200,+$G(BDGUSR),.01)
S VALMHDR(1)=$$PAD("User:",12)_X
S VALMHDR(2)="Date Range: "_$$RANGE^BDGF(BDGBD,BDGED)
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BDGSPT1",$J),^TMP("BDGSPT1A",$J)
;
NEW DFN,RVDT,START,END,LINE,SORT,IENS,X
S START=(9999999.9999-(BDGED+.24))-.0001,END=(9999999.9999-BDGBD)
S DFN=0 F S DFN=$O(^DGSL(38.1,"AU",DFN)) Q:'DFN D
. S RVDT=START F S RVDT=$O(^DGSL(38.1,"AU",DFN,BDGUSR,RVDT)) Q:'RVDT Q:(RVDT>END) D
. . S ^TMP("BDGSPT1A",$J,$$SORT(DFN,RVDT),DFN,RVDT)="" ;put patients found in sorted order
;
; now take sorted list and place into display array
S SORT=0 F S SORT=$O(^TMP("BDGSPT1A",$J,SORT)) Q:SORT="" D
. S DFN=0 F S DFN=$O(^TMP("BDGSPT1A",$J,SORT,DFN)) Q:'DFN D
. . S RVDT=0 F S RVDT=$O(^TMP("BDGSPT1A",$J,SORT,DFN,RVDT)) Q:'RVDT D
. . . S IENS=RVDT_","_DFN
. . . S LINE=$$PAD(" "_$E($$GET1^DIQ(2,DFN,.01),1,21),24)_$J($$HRCN^BDGF2(DFN,DUZ(2)),6) ;patient/chart#
. . . S LINE=$$PAD(LINE,34)_$E($$READRVD^BDGF(RVDT),1,18) ;date/time accessed
. . . ;S LINE=$$PAD(LINE,54)_$E($$GET1^DIQ(38.11,IENS,3),1,15) ;option accessed cmi/anch/maw 9/12/2007 orig line
. . . S LINE=$$PAD(LINE,54)_$E($$GET1^DIQ(38.11,IENS,3),1,22) ;option accessed cmi/anch/maw 9/12/2007 per ljf email PATCH 1007
. . . ;S X=$$SENS(DFN,RVDT) I X]"" S LINE=$$PAD(LINE,70)_"/ "_X ;sensitivity level cmi/anch/maw 9/12/2007 orig line
. . . S X=$$SENS(DFN,RVDT) I X]"" S LINE=$$PAD(LINE,77)_"/ "_$E(X,1,2) ;sensitivity level cmi/anch/maw 9/12/2007 per ljf email PATCH 1007
. . . S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,LINE) ;store in display array
;
I '$D(^TMP("BDGSPT1",$J)) S VALMCNT=1 D SET^VALM10(1,$$SP(10)_"No data found")
K ^TMP("BDGSPT1A",$J)
Q
;
SORT(PAT,RVDT) ; returns sort value for entry
I BDGSORT=1 Q RVDT
I BDGSORT=2 Q $$GET1^DIQ(2,PAT,.01)
NEW X S X=$$GET1^DIQ(38.11,RVDT_","_PAT,3)
Q $S(X="":"UNKNOWN",1:X)
;
SENS(PAT,RVDT) ; returns patient's sensitivity level on date, if known
;status as to patinet being an inpatient or outpatient on date is returned too
NEW DATE,STATUS
S X=$$GET1^DIQ(38.11,RVDT_","_PAT,4),STATUS=$S(X="YES":"INPT",X="NO":"OUTPT",1:"")
S DATE=9999999.9999-RVDT
I DATE<($$GET1^DIQ(38.1,PAT,4,"I")) Q "UNK"_"-"_STATUS
Q $E($$GET1^DIQ(38.1,PAT,2),1,3)_"-"_STATUS
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGSPT1",$J)
Q
;
EXPND ; -- expand code
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BDGSPT1 ; IHS/OIT/LJF - DISPLAY PATIENTS ACCESSED BY A USER
+1 ;;5.3;PIMS;**1005,1007**;MAY 28,2004
+2 ;IHS/OIT/LJF 01/20/2006 PATCH 1005 Added this routine
+3 ;
+4 NEW BDGUSR,BDGBD,BDGED,SCREEN,BDGSORT
+5 SET SCREEN="I $P(^VA(200,+Y,0),U,11)="""""
+6 ;S BDGUSR=+$$READ^BDGF("PO^200:EMQZ","Select USER",,SCREEN) Q:BDGUSR<1 cmi/anch/maw 8/23/2007 orig line PATCH 1007
+7 ;cmi/anch/maw 8/23/2007 mod per linda fels PATCH 1007
SET BDGUSR=+$$READ^BDGF("PO^200:EMQZ","Select USER",,,SCREEN)
IF BDGUSR<1
QUIT
+8 SET BDGBD=$$READ^BDGF("DO^::EPX","Select EARLIEST DATE")
IF 'BDGBD
QUIT
+9 SET BDGED=$$READ^BDGF("DO^"_BDGBD_":"_DT_":EX","Select LATEST DATE")
IF 'BDGED
QUIT
+10 SET BDGSORT=$$READ^BDGF("SO^1:BY DATE;2:BY PATIENT NAME;3:BY OPTION","Select How You Want the Report SORTED")
+11 ;
EN ; -- main entry point for BDG SECURITY USER LIST
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BDG SECURITY USER LIST")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW X
+2 SET X=$$GET1^DIQ(200,+$GET(BDGUSR),.01)
+3 SET VALMHDR(1)=$$PAD("User:",12)_X
+4 SET VALMHDR(2)="Date Range: "_$$RANGE^BDGF(BDGBD,BDGED)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BDGSPT1",$JOB),^TMP("BDGSPT1A",$JOB)
+2 ;
+3 NEW DFN,RVDT,START,END,LINE,SORT,IENS,X
+4 SET START=(9999999.9999-(BDGED+.24))-.0001
SET END=(9999999.9999-BDGBD)
+5 SET DFN=0
FOR
SET DFN=$ORDER(^DGSL(38.1,"AU",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+6 SET RVDT=START
FOR
SET RVDT=$ORDER(^DGSL(38.1,"AU",DFN,BDGUSR,RVDT))
IF 'RVDT
QUIT
IF (RVDT>END)
QUIT
Begin DoDot:2
+7 ;put patients found in sorted order
SET ^TMP("BDGSPT1A",$JOB,$$SORT(DFN,RVDT),DFN,RVDT)=""
End DoDot:2
End DoDot:1
+8 ;
+9 ; now take sorted list and place into display array
+10 SET SORT=0
FOR
SET SORT=$ORDER(^TMP("BDGSPT1A",$JOB,SORT))
IF SORT=""
QUIT
Begin DoDot:1
+11 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BDGSPT1A",$JOB,SORT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+12 SET RVDT=0
FOR
SET RVDT=$ORDER(^TMP("BDGSPT1A",$JOB,SORT,DFN,RVDT))
IF 'RVDT
QUIT
Begin DoDot:3
+13 SET IENS=RVDT_","_DFN
+14 ;patient/chart#
SET LINE=$$PAD(" "_$EXTRACT($$GET1^DIQ(2,DFN,.01),1,21),24)_$JUSTIFY($$HRCN^BDGF2(DFN,DUZ(2)),6)
+15 ;date/time accessed
SET LINE=$$PAD(LINE,34)_$EXTRACT($$READRVD^BDGF(RVDT),1,18)
+16 ;S LINE=$$PAD(LINE,54)_$E($$GET1^DIQ(38.11,IENS,3),1,15) ;option accessed cmi/anch/maw 9/12/2007 orig line
+17 ;option accessed cmi/anch/maw 9/12/2007 per ljf email PATCH 1007
SET LINE=$$PAD(LINE,54)_$EXTRACT($$GET1^DIQ(38.11,IENS,3),1,22)
+18 ;S X=$$SENS(DFN,RVDT) I X]"" S LINE=$$PAD(LINE,70)_"/ "_X ;sensitivity level cmi/anch/maw 9/12/2007 orig line
+19 ;sensitivity level cmi/anch/maw 9/12/2007 per ljf email PATCH 1007
SET X=$$SENS(DFN,RVDT)
IF X]""
SET LINE=$$PAD(LINE,77)_"/ "_$EXTRACT(X,1,2)
+20 ;store in display array
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,LINE)
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 IF '$DATA(^TMP("BDGSPT1",$JOB))
SET VALMCNT=1
DO SET^VALM10(1,$$SP(10)_"No data found")
+23 KILL ^TMP("BDGSPT1A",$JOB)
+24 QUIT
+25 ;
SORT(PAT,RVDT) ; returns sort value for entry
+1 IF BDGSORT=1
QUIT RVDT
+2 IF BDGSORT=2
QUIT $$GET1^DIQ(2,PAT,.01)
+3 NEW X
SET X=$$GET1^DIQ(38.11,RVDT_","_PAT,3)
+4 QUIT $SELECT(X="":"UNKNOWN",1:X)
+5 ;
SENS(PAT,RVDT) ; returns patient's sensitivity level on date, if known
+1 ;status as to patinet being an inpatient or outpatient on date is returned too
+2 NEW DATE,STATUS
+3 SET X=$$GET1^DIQ(38.11,RVDT_","_PAT,4)
SET STATUS=$SELECT(X="YES":"INPT",X="NO":"OUTPT",1:"")
+4 SET DATE=9999999.9999-RVDT
+5 IF DATE<($$GET1^DIQ(38.1,PAT,4,"I"))
QUIT "UNK"_"-"_STATUS
+6 QUIT $EXTRACT($$GET1^DIQ(38.1,PAT,2),1,3)_"-"_STATUS
+7 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGSPT1",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
