Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGSPT3

BDGSPT3.m

Go to the documentation of this file.
  1. BDGSPT3 ; IHS/OIT/LJF - DISPLAY USER'S REESTRICTION TO A SPECIFIC PATIENT
  1. ;;5.3;PIMS;**1008,1009**;MAY 28, 2004
  1. ;IHS/OIT/LJF 08/23/2007 ROUTINE ADDED with Patch 1008
  1. ;
  1. EN ;EP; -- main entry point for BDG SECURITY VIEW RESTRICTIONS
  1. ; assumes DFN and BDGSUR already set
  1. ; called by ^BDGSPT2 for view action
  1. NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1. D EN^VALM("BDG SECURITY VIEW RESTRICTIONS")
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. HDR ;EP; -- header code
  1. NEW X
  1. S X=$$GET1^DIQ(200,+$G(BDGUSR),.01)
  1. S VALMHDR(1)=$$PAD("User:",12)_X_$$SP(7)_$$GET1^DIQ(200,+$G(BDGUSR),8)
  1. S VALMHDR(2)=$$SP(12)_"Last Signed on "_$$GET1^DIQ(200,+$G(BDGUSR),202)
  1. S VALMHDR(3)=""
  1. S VALMHDR(4)=$$PAD("Patient:",12)_$$GET1^DIQ(2,DFN,.01)_" ("_$$STATUS^BDGSPT2(BDGUSR,DFN,2)_")"
  1. Q
  1. ;
  1. INIT ;EP; -- init variables and list array
  1. S VALMCNT=0 K ^TMP("BDGSPT3",$J)
  1. ;
  1. NEW DTSTAMP,LINE,IENS,LIFT,USER,RESUME
  1. ; display when patient record was first restricted
  1. S LINE=" "_$$GET1^DIQ(9009018.11,DFN_","_BDGUSR,.02)
  1. S LINE=$$PAD(LINE,66)_$$GET1^DIQ(9009018.11,DFN_","_BDGUSR,.03) ;user who added it
  1. D SET(LINE,.VALMCNT)
  1. ;
  1. ; find all activity on this record & add to display array
  1. S DTSTAMP=0 F S DTSTAMP=$O(^BDGSPT(BDGUSR,1,DFN,1,DTSTAMP)) Q:'DTSTAMP D
  1. . S IENS=DTSTAMP_","_DFN_","_BDGUSR
  1. . S LIFT=$$GET1^DIQ(9009018.111,IENS,.03) ;date restriction lifted
  1. . S USER=$$GET1^DIQ(9009018.111,IENS,.02) ;user
  1. . S USER2=$$GET1^DIQ(9009018.111,IENS,.08) ;user who last edited
  1. . S LINE=$$PAD($$SP(24)_LIFT,47)
  1. . S LINE=$$PAD(LINE,66)_$S(USER2]"":USER2,1:USER)
  1. . D SET(LINE,.VALMCNT)
  1. . ;
  1. . S RESUME=$$GET1^DIQ(9009018.111,IENS,.04) ;date restriction resumes
  1. . I RESUME]"" D
  1. . . S USER=$$GET1^DIQ(9009018.111,IENS,.06) ;user
  1. . . S LINE=$$SP(47)_RESUME
  1. . . S LINE=$$PAD(LINE,66)_USER
  1. . . D SET(LINE,.VALMCNT)
  1. ;
  1. I '$D(^TMP("BDGSPT3",$J)) S VALMCNT=1,^TMP("BDGSPT3",$J,1,0)=$$SP(15)_"NO INFORMATION FOUND"
  1. Q
  1. ;
  1. SET(LINE,NUM) ; put display line into array
  1. S NUM=NUM+1
  1. S ^TMP("BDGSPT3",$J,NUM,0)=LINE
  1. Q
  1. ;
  1. HELP ;EP; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ;EP; -- exit code
  1. K ^TMP("BDGSPT3",$J)
  1. Q
  1. ;
  1. EXPND ;EP; -- expand code
  1. Q
  1. ;
  1. PAD(D,L) ; -- SUBRTN to pad length of data
  1. ; -- D=data L=length
  1. Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1. ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1. Q $$PAD(" ",N)