- 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)
