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