BSDOVB.m

BSDOVB ; IHS/ANMC/LJF - LIST OVERBOOK KEY HOLDERS ;  [ 06/26/2003  4:13 PM ]

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point for BSDSM OVERBOOK ALL

 D MSG^BDGF("Please wait while I build the list...",2,0)

 NEW VALMCNT

 D TERM^VALM0

 D EN^VALM("BSDSM OVERBOOK ALL")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)=$$SP(10)_"USERS WITH KEYS THAT GIVE THEM OVERBOOK IN ALL CLINICS"

 Q

 ;

INIT ; -- find all users with SDOB and SDMOB keys

 NEW BSDLN,KEY,LINE,USER

 S BSDLN=0 K ^TMP("BSDOVB",$J)

 F KEY="SDOB","SDMOB" D

 . I KEY="SDMOB" D SET("",.BSDLN)

 . S LINE=KEY_":  "_$S(KEY="SDMOB":"MASTER ",1:"")_"OVERBOOK ACCESS"

 . D SET(LINE,.BSDLN)

 . ;

 . I '$O(^XUSEC(KEY,0)) D SET($$SP(3)_"*** NO ONE HAS THIS KEY ***",.BSDLN) Q

 . S USER=0 F  S USER=$O(^XUSEC(KEY,USER)) Q:'USER  D

 .. S LINE=$$SP(3)_$$PAD($$GET1^DIQ(200,USER,.01),36)

 ..;IHS/ITSC/WAR 6/26/03 ADDED

 .. S LINE=LINE_$$PAD($$GET1^DIQ(200,USER,8),31)          ;TITLE

 .. S LINE=LINE_$$PAD($$GET1^DIQ(200,USER,29),31)         ;SVC CNTR

 .. I $$INACT(USER)]"" D

 ... S LINE=$E(LINE,1,35)_$$INACT(USER)   ;Purposely truncated prev data

 .. D SET(LINE,.BSDLN)

 S VALMCNT=BSDLN

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

INACT(USER) ; -- returns inactivated date if any

 NEW X

 S X=$$GET1^DIQ(200,+USER,9.2)

 Q $S(X="":"",1:"Inactivated on "_X)

 ;

SET(DATA,LINENUM) ; -- sets display data into array

 S LINENUM=LINENUM+1

 S ^TMP("BSDOVB",$J,LINENUM,0)=DATA

 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)

BSDOVB    ; IHS/ANMC/LJF - LIST OVERBOOK KEY HOLDERS ;  [ 06/26/2003  4:13 PM ]

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

EN        ; -- main entry point for BSDSM OVERBOOK ALL

 +1        DO MSG^BDGF("Please wait while I build the list...",2,0)

 +2        NEW VALMCNT

 +3        DO TERM^VALM0

 +4        DO EN^VALM("BSDSM OVERBOOK ALL")

 +5        DO CLEAR^VALM1

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=$$SP(10)_"USERS WITH KEYS THAT GIVE THEM OVERBOOK IN ALL CLINICS"

 +2        QUIT 

 +3       ;

INIT      ; -- find all users with SDOB and SDMOB keys

 +1        NEW BSDLN,KEY,LINE,USER

 +2        SET BSDLN=0

           KILL ^TMP("BSDOVB",$JOB)

 +3        FOR KEY="SDOB","SDMOB"

               Begin DoDot:1

 +4                IF KEY="SDMOB"

                       DO SET("",.BSDLN)

 +5                SET LINE=KEY_":  "_$SELECT(KEY="SDMOB":"MASTER ",1:"")_"OVERBOOK ACCESS"

 +6                DO SET(LINE,.BSDLN)

 +7       ;

 +8                IF '$ORDER(^XUSEC(KEY,0))

                       DO SET($$SP(3)_"*** NO ONE HAS THIS KEY ***",.BSDLN)

                       QUIT 

 +9                SET USER=0

                   FOR 

                       SET USER=$ORDER(^XUSEC(KEY,USER))

                       IF 'USER

                           QUIT 

                       Begin DoDot:2

 +10                       SET LINE=$$SP(3)_$$PAD($$GET1^DIQ(200,USER,.01),36)

 +11      ;IHS/ITSC/WAR 6/26/03 ADDED

 +12      ;TITLE

                           SET LINE=LINE_$$PAD($$GET1^DIQ(200,USER,8),31)

 +13      ;SVC CNTR

                           SET LINE=LINE_$$PAD($$GET1^DIQ(200,USER,29),31)

 +14                       IF $$INACT(USER)]""

                               Begin DoDot:3

 +15      ;Purposely truncated prev data

                                   SET LINE=$EXTRACT(LINE,1,35)_$$INACT(USER)

                               End DoDot:3

 +16                       DO SET(LINE,.BSDLN)

                       End DoDot:2

               End DoDot:1

 +17       SET VALMCNT=BSDLN

 +18       QUIT 

 +19      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

INACT(USER) ; -- returns inactivated date if any

 +1        NEW X

 +2        SET X=$$GET1^DIQ(200,+USER,9.2)

 +3        QUIT $SELECT(X="":"",1:"Inactivated on "_X)

 +4       ;

SET(DATA,LINENUM) ; -- sets display data into array

 +1        SET LINENUM=LINENUM+1

 +2        SET ^TMP("BSDOVB",$JOB,LINENUM,0)=DATA

 +3        QUIT 

 +4       ;

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)