BDGSEC2.m

BDGSEC2 ; IHS/ANMC/LJF - SENSITIVE PAT DISPLAY ; [ 01/16/2004  3:41 PM ]

 ;;5.3;PIMS;**1007,1008**;APR 26, 2002

 ;

 ;cmi/anch/maw 9/7/2007 mods for PATCH 1007 in PRINT

 ;

 D PID^VADPT6  ;set ID #

 ;I IOST'["C-" U IO D INIT,PRINT Q  ;cmi/anch/maw 9/7/2007 orig line

 I IOST'["C-" S BDGION=IO D INIT,PRINT Q  ;cmi/anch/maw 9/7/2007 per linda fels PATCH 1007

 ;

EN ; -- main entry point for BDG SECURITY DISPLAY

 NEW VALMCNT D TERM^VALM0

 D EN^VALM("BDG SECURITY DISPLAY")

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="Sensitive Patient Access for "_DGRNG1_" to "_DGRNG2

 S VALMHDR(2)=$$PAD("Patient Name: "_DGNAM,40)_"  #"_$G(HRCN)

 S VALMHDR(2)=$$PAD(VALMHDR(2),50)_"Date of Birth : "_$$FMTE^XLFDT(DOB)

 Q

 ;

INIT ; -- init variables and list array

 NEW X

 K ^TMP("BDGSEC",$J),^TMP("BDGSEC2",$J)

 D GUIR^XBLM("START^DGSEC2","^TMP(""BDGSEC"",$J,")

 S X=0 F  S X=$O(^TMP("BDGSEC",$J,X)) Q:'X  D

 . S VALMCNT=X

 . S ^TMP("BDGSEC2",$J,X,0)=" "_^TMP("BDGSEC",$J,X)

 S VALMCNT=+$G(VALMCNT)

 K ^TMP("BDGSEC",$J)

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

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

 D KILL^AUPNPAT K VA,HRCN,DGDATE,DGTIME,DGUSR,DIC,VAERR

 D Q^DGSEC2

 Q

 ;

EXPND ; -- expand code

 Q

 ;

PRINT ; -- print report to paper

 S IOP=BDGION D ^%ZIS U IO K BDGION  ;cmi/anch/maw 9/7/2007 per linda fels PATCH 1007

 NEW LINE

 S LINE=0 D HD

 F  S LINE=$O(^TMP("BDGSEC2",$J,LINE)) Q:'LINE  D

 . I $Y>(IOSL-4) D HD

 . W !,$G(^TMP("BDGSEC2",$J,LINE,0))

 D ^%ZISC D EXIT

 Q

 ;

HD ; -- print heading

 W @IOF,!,"Sensitive Patient Access Report for ",DGRNG1," to ",DGRNG2

 S DGPGE=DGPGE+1 W ?70,"Page: ",DGPGE

 K DGLNE S $P(DGLNE,"=",80)="" W !,DGLNE,!,"Run Date    : "

 D H^DGUTL S Y=DGTIME W ?14 D DT^DIQ

 W ?47,"Patient ID Num: ",$G(HRCN)

 W !,"Patient Name: ",$S($D(DGNAM):DGNAM,1:"Unknown")

 W ?47,"Date of Birth : " S Y=$S($D(DOB):DOB,1:"Unknown") D DT^DIQ

 W !,DGLNE K DGLNE S $P(DGLNE,"-",80)=""

 W !!,"USER",?23,"DATE ACCESSED",?46,"OPTION/PROTOCOL USED"

 W ?70,"INPATIENT",!,DGLNE

 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)

BDGSEC2   ; IHS/ANMC/LJF - SENSITIVE PAT DISPLAY ; [ 01/16/2004  3:41 PM ]

 +1       ;;5.3;PIMS;**1007,1008**;APR 26, 2002

 +2       ;

 +3       ;cmi/anch/maw 9/7/2007 mods for PATCH 1007 in PRINT

 +4       ;

 +5       ;set ID #

           DO PID^VADPT6

 +6       ;I IOST'["C-" U IO D INIT,PRINT Q  ;cmi/anch/maw 9/7/2007 orig line

 +7       ;cmi/anch/maw 9/7/2007 per linda fels PATCH 1007

           IF IOST'["C-"

               SET BDGION=IO

               DO INIT

               DO PRINT

               QUIT 

 +8       ;

EN        ; -- main entry point for BDG SECURITY DISPLAY

 +1        NEW VALMCNT

           DO TERM^VALM0

 +2        DO EN^VALM("BDG SECURITY DISPLAY")

 +3        QUIT 

 +4       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="Sensitive Patient Access for "_DGRNG1_" to "_DGRNG2

 +2        SET VALMHDR(2)=$$PAD("Patient Name: "_DGNAM,40)_"  #"_$GET(HRCN)

 +3        SET VALMHDR(2)=$$PAD(VALMHDR(2),50)_"Date of Birth : "_$$FMTE^XLFDT(DOB)

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1        NEW X

 +2        KILL ^TMP("BDGSEC",$JOB),^TMP("BDGSEC2",$JOB)

 +3        DO GUIR^XBLM("START^DGSEC2","^TMP(""BDGSEC"",$J,")

 +4        SET X=0

           FOR 

               SET X=$ORDER(^TMP("BDGSEC",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +5                SET VALMCNT=X

 +6                SET ^TMP("BDGSEC2",$JOB,X,0)=" "_^TMP("BDGSEC",$JOB,X)

               End DoDot:1

 +7        SET VALMCNT=+$GET(VALMCNT)

 +8        KILL ^TMP("BDGSEC",$JOB)

 +9        QUIT 

 +10      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

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

 +2        DO KILL^AUPNPAT

           KILL VA,HRCN,DGDATE,DGTIME,DGUSR,DIC,VAERR

 +3        DO Q^DGSEC2

 +4        QUIT 

 +5       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

PRINT     ; -- print report to paper

 +1       ;cmi/anch/maw 9/7/2007 per linda fels PATCH 1007

           SET IOP=BDGION

           DO ^%ZIS

           USE IO

           KILL BDGION

 +2        NEW LINE

 +3        SET LINE=0

           DO HD

 +4        FOR 

               SET LINE=$ORDER(^TMP("BDGSEC2",$JOB,LINE))

               IF 'LINE

                   QUIT 

               Begin DoDot:1

 +5                IF $Y>(IOSL-4)

                       DO HD

 +6                WRITE !,$GET(^TMP("BDGSEC2",$JOB,LINE,0))

               End DoDot:1

 +7        DO ^%ZISC

           DO EXIT

 +8        QUIT 

 +9       ;

HD        ; -- print heading

 +1        WRITE @IOF,!,"Sensitive Patient Access Report for ",DGRNG1," to ",DGRNG2

 +2        SET DGPGE=DGPGE+1

           WRITE ?70,"Page: ",DGPGE

 +3        KILL DGLNE

           SET $PIECE(DGLNE,"=",80)=""

           WRITE !,DGLNE,!,"Run Date    : "

 +4        DO H^DGUTL

           SET Y=DGTIME

           WRITE ?14

           DO DT^DIQ

 +5        WRITE ?47,"Patient ID Num: ",$GET(HRCN)

 +6        WRITE !,"Patient Name: ",$SELECT($DATA(DGNAM):DGNAM,1:"Unknown")

 +7        WRITE ?47,"Date of Birth : "

           SET Y=$SELECT($DATA(DOB):DOB,1:"Unknown")

           DO DT^DIQ

 +8        WRITE !,DGLNE

           KILL DGLNE

           SET $PIECE(DGLNE,"-",80)=""

 +9        WRITE !!,"USER",?23,"DATE ACCESSED",?46,"OPTION/PROTOCOL USED"

 +10       WRITE ?70,"INPATIENT",!,DGLNE

 +11       QUIT 

 +12      ;

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)