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

BSDUSR.m

Go to the documentation of this file.
  1. BSDUSR ; IHS/ANMC/LJF - DISPLAY USER SETUP ;
  1. ;;5.3;PIMS;**1007**;FEB 27, 2007
  1. ;
  1. ;cmi/anch/maw 11/22/2006 PATCH 1007 removed screen of terminated users in ASK for item 1007.31
  1. ;
  1. ASK ; -- ask for user name
  1. NEW DIC,X,Y
  1. S DIC=200,DIC(0)="AEMQ",DIC("A")="Select SCHEDULING USER: "
  1. ;S DIC("S")="I $P(^VA(200,+Y,0),U,3)]"""",$P(^(0),U,11)=""""" ;cmi/anch/maw 11/22/06 orig line item 1007.31 patch 1007
  1. S DIC("S")="I $P(^VA(200,+Y,0),U,3)]""""" ;cmi/anch/maw 11/22/06 modified line item 1007.31 patch 1007
  1. D ^DIC I (X="")!(X=U)!(Y<1) S BSDQ=1 D EXIT Q
  1. S BSDU=Y
  1. ;
  1. DEV ; -- ask for device
  1. D ZIS^BDGF("QP","EN^BSDUSL","DISPLAY SCHED USER","BSDU")
  1. ;
  1. EXIT ; -- eoj
  1. D ^%ZISC K BSDU,BSDQ,BSDLN Q
  1. ;
  1. DISP ;EP; -- display user data
  1. NEW BSDL
  1. K ^TMP("BSDUSL",$J) S BSDLN=0
  1. S BSDL=$$PAD("Name: "_$E($P(BSDU,U,2),1,20),25)
  1. S X=$$GET1^DIQ(200,+BSDU,29)
  1. I X]"" S BSDL=BSDL_$$PAD("Service: "_$E(X,1,22),33)
  1. S X=$$GET1^DIQ(200,+BSDU,.132)
  1. I X]"" S BSDL=BSDL_"Phone: "_$E(X,1,12)
  1. D SET(BSDL),SET(" ")
  1. D KEYS,OVERBK,ACCESS
  1. I IOST'["C-" D PRINT
  1. Q
  1. ;
  1. KEYS ; -- display user's sd keys and descriptions
  1. NEW BSDX,BSDY
  1. D SET("User's Access based on Security Keys:")
  1. S BSDX="SDZ"
  1. F S BSDX=$O(^DIC(19.1,"B",BSDX)) Q:(BSDX="")!($E(BSDX,1,2)'="SD") D
  1. . Q:'$D(^XUSEC(BSDX,+BSDU))
  1. . S BSDY=$O(^DIC(19.1,"B",BSDX,0)) Q:BSDY=""
  1. . D SET($$SP(5)_$$GET1^DIQ(19.1,BSDY,.02))
  1. I $D(^XUSEC("AGZDOG",+BSDU)) D
  1. . D SET($$SP(5)_"CAN ACCESS FULL REGISTRATION EDIT")
  1. D SET("")
  1. Q
  1. ;
  1. OVERBK ; -- display overbook level
  1. NEW BSDX
  1. I $D(^XUSEC("SDMOB",+BSDU)) D Q
  1. . D SET($$SP(5)_"Has MASTER OVERBOOK in all clinics")
  1. I $D(^XUSEC("SDOB",+BSDU)) D
  1. . D SET($$SP(5)_"Has OVERBOOK access in all clinics")
  1. I $D(^BSDSC("AOV",+BSDU)) D
  1. . D SET($$SP(5)_"Has OVERBOOK access in these clinics:")
  1. S BSDX=0 F S BSDX=$O(^BSDSC("AOV",+BSDU,BSDX)) Q:BSDX="" D
  1. . D SET($$SP(10)_$$GET1^DIQ(44,BSDX,.01)_$$MSTOV)
  1. Q
  1. ;
  1. MSTOV() ; -- returns whether user has master ovbk in clinic
  1. NEW X
  1. S X=$P($G(^BSDSC(BSDX,1,+BSDU,0)),U,2)
  1. Q $S(X="M":" (Master Overbook)",1:"")
  1. ;
  1. ACCESS ; -- display access to restricted clinics
  1. NEW BSDX
  1. Q:'$D(^SC("AIHSPRIV",+BSDU)) D SET(" ")
  1. D SET($$SP(5)_"Has access to these RESTRICTED Clinics:")
  1. S BSDX=0 F S BSDX=$O(^SC("AIHSPRIV",+BSDU,BSDX)) Q:BSDX="" D
  1. . Q:$$GET1^DIQ(44,BSDX,2500)'="YES"
  1. . S X=$$GET1^DIQ(44,BSDX,2505,"I") I X]"",X'>DT Q
  1. . D SET($$SP(10)_$$GET1^DIQ(44,BSDX,.01))
  1. Q
  1. ;
  1. PRINT ; -- print list if sent to a printer
  1. U IO NEW BSDL,BSDPG
  1. S (BSDPG,BSDL)=0 D HDR
  1. F S BSDL=$O(^TMP("BSDUSL",$J,BSDL)) Q:'BSDL D
  1. . I $Y>(IOSL-3) D HDR
  1. . W !,^TMP("BSDUSL",$J,BSDL,0)
  1. D EXIT
  1. Q
  1. ;
  1. HDR ; -- header
  1. W:BSDPG>0 @IOF S BSDPG=BSDPG+1
  1. W !?30,"SCHEDULING USER SETUP",!
  1. Q
  1. ;
  1. SET(DATA) ; -- sets ^tmp
  1. S BSDLN=BSDLN+1,^TMP("BSDUSL",$J,BSDLN,0)=DATA
  1. S ^TMP("BSDUSL",$J,"IDX",BSDLN,BSDLN)=""
  1. Q
  1. ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1. Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1. ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1. Q $$PAD(" ",NUM)