VistA-WorldVistAEHR/r/CONTROLLED_SUBSTANCES-PSD/PSDNMKY.m

101 lines
3.6 KiB
Mathematica

PSDNMKY ;DOIFO/CMS - CSM Security Key Print ;18 Dec 02
;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
;Reference to ^XUSEC( supported by IA #1095
Q
;
ST ;CS Monitoring OPTION ENTRY
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,X,Y,ZTIO,ZTSK,ZTRTN,ZTDESC,%,%ZIS
W !!,?5,"This report lists current holders of the"
W !,?5,"PSJ RPHARM and/or PSDMGR security keys.",!!
S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
I Y'=1 W " <No report>",! G END
;
K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
I $D(IO("Q")) D
.S ZTRTN="DQ^PSDNMKY",ZTDESC="CS Monitoring - PSDNMKY"
.D ^%ZTLOAD W !!?5,"TASK #",$G(ZTSK)," QUEUED!",!
I '$D(IO("Q")) U IO D DQ
K IOP,IO("Q")
END Q
;
;
HD ;Report heading
N PSDH,X,Y,%
W @IOF,$$CJ^XLFSTR("CS Monitoring - Security Key Report",IOM)
S PSDH="SECURITY KEY: "_$S(PSDK="BOTH":"PSDMGR & PSJ RPHARM",1:PSDK)
W !,$$CJ^XLFSTR(PSDH,IOM)
W !,"Station: ",$G(PSDIV),?20,"Report Run Date: "
S PSDPG=PSDPG+1
D NOW^%DTC W $$FMTE^XLFDT(%),?65,"PAGE: ",PSDPG
W !,$$REPEAT^XLFSTR("=",IOM)
QUIT
;
DQ ;Report Run
N D0,DA,DIC,DIQ,DR
N PSDIV,PSDK,PSDN,PSDO,PSDOUT,PSDPG,PSDS,PSDT,PSDTI,PSDX,PSDY,X,Y,%
K ^TMP("PSDNMKY",$J)
I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
S PSDX=0
F S PSDX=$O(^XUSEC("PSDMGR",PSDX)) Q:'PSDX D
. S PSDN=$G(^VA(200,PSDX,0)) I PSDN']"" Q
. S DA=PSDX,DR=".01;8;9.2;29",DIQ="PSDO",DIQ(0)="E",DIC="^VA(200,"
. K PSDO D EN^DIQ1
. S PSDN=$G(PSDO(200,PSDX,.01,"E"))
. S PSDN=$S(PSDN]"":PSDN,1:"NO NAME (ien="_+PSDX_")")
. S PSDTI=$G(PSDO(200,PSDX,8,"E"))
. S PSDTI=$S(PSDTI]"":PSDTI,1:"UNKNOWN")
. S PSDT=$G(PSDO(200,PSDX,9.2,"E"))
. S PSDS=$G(PSDO(200,PSDX,29,"E"))
. S PSDS=$S(PSDS]"":PSDS,1:"UNKNOWN")
. I $D(^XUSEC("PSJ RPHARM",PSDX)) D Q
. . S ^TMP("PSDNMKY",$J,"BOTH",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
. S ^TMP("PSDNMKY",$J,"PSDMGR",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
;
S PSDX=0
F S PSDX=$O(^XUSEC("PSJ RPHARM",PSDX)) Q:'PSDX D
. S PSDN=$G(^VA(200,PSDX,0)) I PSDN']"" Q
. S DA=PSDX,DR=".01;8;9.2;29",DIQ="PSDO",DIQ(0)="E",DIC="^VA(200,"
. K PSDO D EN^DIQ1
. S PSDN=$G(PSDO(200,PSDX,.01,"E"))
. S PSDN=$S(PSDN]"":PSDN,1:"NO NAME (ien="_+PSDX_")")
. S PSDTI=$G(PSDO(200,PSDX,8,"E"))
. S PSDTI=$S(PSDTI]"":PSDTI,1:"UNKNOWN")
. S PSDT=$G(PSDO(200,PSDX,9.2,"E"))
. S PSDS=$G(PSDO(200,PSDX,29,"E"))
. S PSDS=$S(PSDS]"":PSDS,1:"UNKNOWN")
. I $D(^XUSEC("PSDMGR",PSDX)) D Q
. . S ^TMP("PSDNMKY",$J,"BOTH",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
. S ^TMP("PSDNMKY",$J,"PSJ RPHARM",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
;
;Report print
S PSDPG=0,PSDOUT=0,PSDIV=+$$SITE^VASITE
I '$D(^TMP("PSDNMKY",$J)) S PSDK="BOTH" D HD,PHD W !!,?10,"<<<< NO DATA FOUND >>>>",! G DQQ
S PSDK=""
F S PSDK=$O(^TMP("PSDNMKY",$J,PSDK)) Q:(PSDK="")!(PSDOUT) D
. S PSDPG=0 D HD,PHD
. S PSDS=""
. F S PSDS=$O(^TMP("PSDNMKY",$J,PSDK,PSDS)) Q:(PSDS="")!(PSDOUT) D
. . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
. . W !!,"SERVICE/SECTION: ",PSDS
. . S PSDN=""
. . F S PSDN=$O(^TMP("PSDNMKY",$J,PSDK,PSDS,PSDN)) Q:(PSDN="")!(PSDOUT) D
. . . S PSDX=0
. . . F S PSDX=$O(^TMP("PSDNMKY",$J,PSDK,PSDS,PSDN,PSDX)) Q:('PSDX)!(PSDOUT) D
. . . . S PSDY=$G(^TMP("PSDNMKY",$J,PSDK,PSDS,PSDN,PSDX))
. . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
. . . . W !,?3,PSDN,?35,$P(PSDY,U,1),?65,$P(PSDY,U,2)
. I '$G(PSDOUT),$O(^TMP("PSDNMKY",$J,PSDK))]"" D PAGE
;
DQQ K ^TMP("PSDNMKY",$J) D ^%ZISC Q
;
PHD W !,?3,"Name",?35,"Title",?64,"Termination Date"
W !,$$REPEAT^XLFSTR("_",IOM)
Q
PAGE ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
I IOST?1"C-".E S DIR(0)="E" D ^DIR W !
I ($D(DTOUT))!($D(DIRUT)) S PSDOUT=1 Q:$G(PSDOUT)=1
Q
;
EOR ;PSDNMKY - CSM Security Key Print; 18 DEC 02