BDGSECL.m

BDGSECL ; IHS/ANMC/LJF - LIST SENSITIVE PATIENTS ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point for BDG SECURITY LIST

 NEW VALMCNT

 D TERM^VALM0

 D EN^VALM("BDG SECURITY LIST")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 NEW X

 S X="Patients stored in DG SECURITY LOG file as of "_$$FMTE^XLFDT(DT)

 S VALMHDR(1)=$$SP(10)_X

 Q

 ;

INIT ; -- init variables and list array

 NEW DGN,NAME,STATUS,DATA,LINE,DGNUM

 K ^TMP("BDGSECL",$J),^TMP("BDGSECL1",$J)

 S VALMCNT=0

 ;

 ; find all entries and sort by status and then by name

 S (DGN,DGNUM)=0

 F  S DGN=$O(^DGSL(38.1,DGN)) Q:'DGN  D

 . S NAME=$$GET1^DIQ(38.1,DGN,.01),STATUS=$$GET1^DIQ(38.1,DGN,2)

 . Q:STATUS'="SENSITIVE"

 . ; assigned by (initials)

 . S X=$$GET1^DIQ(200,+$$GET1^DIQ(38.1,DGN,3,"I"),1)

 . ; date assigned status

 . S Y=$$FMTE^XLFDT($$GET1^DIQ(38.1,DGN,4,"I"))

 . S ^TMP("BDGSECL1",$J,NAME,DGN)=X_U_Y

 ;

 ; if file is empty, set message and quit

 I '$D(^TMP("BDGSECL1",$J)) D SET("No PATIENTS currently or previously defined as SENSITIVE",0,.VALMCNT,0) Q

 ;

 ; otherwise, set display lines per sorts

 S NAME=0 F  S NAME=$O(^TMP("BDGSECL1",$J,NAME)) Q:NAME=""  D

 . S DGN=0 F  S DGN=$O(^TMP("BDGSECL1",$J,NAME,DGN)) Q:'DGN  D

 .. S DATA=^TMP("BDGSECL1",$J,NAME,DGN)

 .. ; create display line

 .. S DGNUM=DGNUM+1                        ;entry # on display screen

 .. S LINE=$J(DGNUM,3)_". "_$E(NAME,1,20)                ;#. pat name

 .. S LINE=$$PAD(LINE,28)_$P(DATA,U,2)                   ;date

 .. S LINE=$$PAD(LINE,50)_$P(DATA,U)                     ;assigned by 

 .. D SET(LINE,DGN,.VALMCNT,.DGNUM)   ;add display line to list global

 ;

 K ^TMP("BDGSECL1",$J)

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K VALMCNT,^TMP("BDGSECL",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

DISPLAY ;EP; -- called by protocol to display access records for patient

 D FULL^VALM1

 I '$D(^XUSEC("DG SECURITY OFFICER",DUZ)) W !!?3,*7,"You do not have the appropriate access privileges to display user access." D PAUSE^BDGF,RESET2 Q

 NEW BDGI

 S BDGI=$$GETITEM^BDGFL("BDGSECL","OS")       ;choose entry to display

 I 'BDGI D RESET2 Q                           ;or go back

 S DFN=$$GET1^DIQ(38.1,+BDGI,.01,"I")         ;set variable for call

 D DTRNG^DGSEC2 I DGPOP D Q^DGSEC2,RESET2 Q  ;ask date range

 D ASKUSR^DGSEC2,RESET2                      ;rest of code for report

 Q

 ;

EDIT ;EP; -- called by protocol to edit sensitivity level

 D FULL^VALM1

 I '$D(^XUSEC("DG SENSITIVITY",DUZ)) W !!?3,$C(7),"You do not have the appropriate access privileges to assign security." D PAUSE^BDGF,RESET2 Q

 NEW BDGI

 S BDGI=$$GETITEM^BDGFL("BDGSECL","OS")       ;choose entry to edit

 I 'BDGI D RESET2 Q                           ;or go back

 S DA=+BDGI,BDGSECL=1  ;calling rtn needs DA set, BDGSECL helps exit

 D IHS^DGSEC1,RESET                 ;call 1^DGSEC1 after patient lookup

 Q

 ;

SET(DATA,IEN,LINE,NUM) ; -- create ^tmp global for list template

 S LINE=LINE+1

 S ^TMP("BDGSECL",$J,LINE,0)=DATA

 S ^TMP("BDGSECL",$J,"IDX",LINE,NUM)=IEN

 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)

 ;

RESET ; -- update partition for return to list manager

 I $D(VALMQUIT) S VALMBCK="Q" Q

 D TERM^VALM0 S VALMBCK="R"

 D INIT,HDR

 Q

 ;

RESET2 ; -- return to list manager; don't update list

 I $D(VALMQUIT) S VALMBCK="Q" Q

 D TERM^VALM0 S VALMBCK="R"

 Q

BDGSECL   ; IHS/ANMC/LJF - LIST SENSITIVE PATIENTS ; 

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

 +2       ;

EN        ; -- main entry point for BDG SECURITY LIST

 +1        NEW VALMCNT

 +2        DO TERM^VALM0

 +3        DO EN^VALM("BDG SECURITY LIST")

 +4        DO CLEAR^VALM1

 +5        QUIT 

 +6       ;

HDR       ; -- header code

 +1        NEW X

 +2        SET X="Patients stored in DG SECURITY LOG file as of "_$$FMTE^XLFDT(DT)

 +3        SET VALMHDR(1)=$$SP(10)_X

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1        NEW DGN,NAME,STATUS,DATA,LINE,DGNUM

 +2        KILL ^TMP("BDGSECL",$JOB),^TMP("BDGSECL1",$JOB)

 +3        SET VALMCNT=0

 +4       ;

 +5       ; find all entries and sort by status and then by name

 +6        SET (DGN,DGNUM)=0

 +7        FOR 

               SET DGN=$ORDER(^DGSL(38.1,DGN))

               IF 'DGN

                   QUIT 

               Begin DoDot:1

 +8                SET NAME=$$GET1^DIQ(38.1,DGN,.01)

                   SET STATUS=$$GET1^DIQ(38.1,DGN,2)

 +9                IF STATUS'="SENSITIVE"

                       QUIT 

 +10      ; assigned by (initials)

 +11               SET X=$$GET1^DIQ(200,+$$GET1^DIQ(38.1,DGN,3,"I"),1)

 +12      ; date assigned status

 +13               SET Y=$$FMTE^XLFDT($$GET1^DIQ(38.1,DGN,4,"I"))

 +14               SET ^TMP("BDGSECL1",$JOB,NAME,DGN)=X_U_Y

               End DoDot:1

 +15      ;

 +16      ; if file is empty, set message and quit

 +17       IF '$DATA(^TMP("BDGSECL1",$JOB))

               DO SET("No PATIENTS currently or previously defined as SENSITIVE",0,.VALMCNT,0)

               QUIT 

 +18      ;

 +19      ; otherwise, set display lines per sorts

 +20       SET NAME=0

           FOR 

               SET NAME=$ORDER(^TMP("BDGSECL1",$JOB,NAME))

               IF NAME=""

                   QUIT 

               Begin DoDot:1

 +21               SET DGN=0

                   FOR 

                       SET DGN=$ORDER(^TMP("BDGSECL1",$JOB,NAME,DGN))

                       IF 'DGN

                           QUIT 

                       Begin DoDot:2

 +22                       SET DATA=^TMP("BDGSECL1",$JOB,NAME,DGN)

 +23      ; create display line

 +24      ;entry # on display screen

                           SET DGNUM=DGNUM+1

 +25      ;#. pat name

                           SET LINE=$JUSTIFY(DGNUM,3)_". "_$EXTRACT(NAME,1,20)

 +26      ;date

                           SET LINE=$$PAD(LINE,28)_$PIECE(DATA,U,2)

 +27      ;assigned by 

                           SET LINE=$$PAD(LINE,50)_$PIECE(DATA,U)

 +28      ;add display line to list global

                           DO SET(LINE,DGN,.VALMCNT,.DGNUM)

                       End DoDot:2

               End DoDot:1

 +29      ;

 +30       KILL ^TMP("BDGSECL1",$JOB)

 +31       QUIT 

 +32      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL VALMCNT,^TMP("BDGSECL",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

DISPLAY   ;EP; -- called by protocol to display access records for patient

 +1        DO FULL^VALM1

 +2        IF '$DATA(^XUSEC("DG SECURITY OFFICER",DUZ))

               WRITE !!?3,*7,"You do not have the appropriate access privileges to display user access."

               DO PAUSE^BDGF

               DO RESET2

               QUIT 

 +3        NEW BDGI

 +4       ;choose entry to display

           SET BDGI=$$GETITEM^BDGFL("BDGSECL","OS")

 +5       ;or go back

           IF 'BDGI

               DO RESET2

               QUIT 

 +6       ;set variable for call

           SET DFN=$$GET1^DIQ(38.1,+BDGI,.01,"I")

 +7       ;ask date range

           DO DTRNG^DGSEC2

           IF DGPOP

               DO Q^DGSEC2

               DO RESET2

               QUIT 

 +8       ;rest of code for report

           DO ASKUSR^DGSEC2

           DO RESET2

 +9        QUIT 

 +10      ;

EDIT      ;EP; -- called by protocol to edit sensitivity level

 +1        DO FULL^VALM1

 +2        IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))

               WRITE !!?3,$CHAR(7),"You do not have the appropriate access privileges to assign security."

               DO PAUSE^BDGF

               DO RESET2

               QUIT 

 +3        NEW BDGI

 +4       ;choose entry to edit

           SET BDGI=$$GETITEM^BDGFL("BDGSECL","OS")

 +5       ;or go back

           IF 'BDGI

               DO RESET2

               QUIT 

 +6       ;calling rtn needs DA set, BDGSECL helps exit

           SET DA=+BDGI

           SET BDGSECL=1

 +7       ;call 1^DGSEC1 after patient lookup

           DO IHS^DGSEC1

           DO RESET

 +8        QUIT 

 +9       ;

SET(DATA,IEN,LINE,NUM) ; -- create ^tmp global for list template

 +1        SET LINE=LINE+1

 +2        SET ^TMP("BDGSECL",$JOB,LINE,0)=DATA

 +3        SET ^TMP("BDGSECL",$JOB,"IDX",LINE,NUM)=IEN

 +4        QUIT 

 +5       ;

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)

 +2       ;

RESET     ; -- update partition for return to list manager

 +1        IF $DATA(VALMQUIT)

               SET VALMBCK="Q"

               QUIT 

 +2        DO TERM^VALM0

           SET VALMBCK="R"

 +3        DO INIT

           DO HDR

 +4        QUIT 

 +5       ;

RESET2    ; -- return to list manager; don't update list

 +1        IF $DATA(VALMQUIT)

               SET VALMBCK="Q"

               QUIT 

 +2        DO TERM^VALM0

           SET VALMBCK="R"

 +3        QUIT