source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDNMKY.m@ 1096

Last change on this file since 1096 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1PSDNMKY ;DOIFO/CMS - CSM Security Key Print ;18 Dec 02
2 ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
3 ;Reference to ^XUSEC( supported by IA #1095
4 Q
5 ;
6ST ;CS Monitoring OPTION ENTRY
7 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,X,Y,ZTIO,ZTSK,ZTRTN,ZTDESC,%,%ZIS
8 W !!,?5,"This report lists current holders of the"
9 W !,?5,"PSJ RPHARM and/or PSDMGR security keys.",!!
10 S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
11 I Y'=1 W " <No report>",! G END
12 ;
13 K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
14 I $D(IO("Q")) D
15 .S ZTRTN="DQ^PSDNMKY",ZTDESC="CS Monitoring - PSDNMKY"
16 .D ^%ZTLOAD W !!?5,"TASK #",$G(ZTSK)," QUEUED!",!
17 I '$D(IO("Q")) U IO D DQ
18 K IOP,IO("Q")
19END Q
20 ;
21 ;
22HD ;Report heading
23 N PSDH,X,Y,%
24 W @IOF,$$CJ^XLFSTR("CS Monitoring - Security Key Report",IOM)
25 S PSDH="SECURITY KEY: "_$S(PSDK="BOTH":"PSDMGR & PSJ RPHARM",1:PSDK)
26 W !,$$CJ^XLFSTR(PSDH,IOM)
27 W !,"Station: ",$G(PSDIV),?20,"Report Run Date: "
28 S PSDPG=PSDPG+1
29 D NOW^%DTC W $$FMTE^XLFDT(%),?65,"PAGE: ",PSDPG
30 W !,$$REPEAT^XLFSTR("=",IOM)
31 QUIT
32 ;
33DQ ;Report Run
34 N D0,DA,DIC,DIQ,DR
35 N PSDIV,PSDK,PSDN,PSDO,PSDOUT,PSDPG,PSDS,PSDT,PSDTI,PSDX,PSDY,X,Y,%
36 K ^TMP("PSDNMKY",$J)
37 I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
38 S PSDX=0
39 F S PSDX=$O(^XUSEC("PSDMGR",PSDX)) Q:'PSDX D
40 . S PSDN=$G(^VA(200,PSDX,0)) I PSDN']"" Q
41 . S DA=PSDX,DR=".01;8;9.2;29",DIQ="PSDO",DIQ(0)="E",DIC="^VA(200,"
42 . K PSDO D EN^DIQ1
43 . S PSDN=$G(PSDO(200,PSDX,.01,"E"))
44 . S PSDN=$S(PSDN]"":PSDN,1:"NO NAME (ien="_+PSDX_")")
45 . S PSDTI=$G(PSDO(200,PSDX,8,"E"))
46 . S PSDTI=$S(PSDTI]"":PSDTI,1:"UNKNOWN")
47 . S PSDT=$G(PSDO(200,PSDX,9.2,"E"))
48 . S PSDS=$G(PSDO(200,PSDX,29,"E"))
49 . S PSDS=$S(PSDS]"":PSDS,1:"UNKNOWN")
50 . I $D(^XUSEC("PSJ RPHARM",PSDX)) D Q
51 . . S ^TMP("PSDNMKY",$J,"BOTH",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
52 . S ^TMP("PSDNMKY",$J,"PSDMGR",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
53 ;
54 S PSDX=0
55 F S PSDX=$O(^XUSEC("PSJ RPHARM",PSDX)) Q:'PSDX D
56 . S PSDN=$G(^VA(200,PSDX,0)) I PSDN']"" Q
57 . S DA=PSDX,DR=".01;8;9.2;29",DIQ="PSDO",DIQ(0)="E",DIC="^VA(200,"
58 . K PSDO D EN^DIQ1
59 . S PSDN=$G(PSDO(200,PSDX,.01,"E"))
60 . S PSDN=$S(PSDN]"":PSDN,1:"NO NAME (ien="_+PSDX_")")
61 . S PSDTI=$G(PSDO(200,PSDX,8,"E"))
62 . S PSDTI=$S(PSDTI]"":PSDTI,1:"UNKNOWN")
63 . S PSDT=$G(PSDO(200,PSDX,9.2,"E"))
64 . S PSDS=$G(PSDO(200,PSDX,29,"E"))
65 . S PSDS=$S(PSDS]"":PSDS,1:"UNKNOWN")
66 . I $D(^XUSEC("PSDMGR",PSDX)) D Q
67 . . S ^TMP("PSDNMKY",$J,"BOTH",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
68 . S ^TMP("PSDNMKY",$J,"PSJ RPHARM",PSDS,$P(PSDN,U,1),PSDX)=PSDTI_U_PSDT
69 ;
70 ;Report print
71 S PSDPG=0,PSDOUT=0,PSDIV=+$$SITE^VASITE
72 I '$D(^TMP("PSDNMKY",$J)) S PSDK="BOTH" D HD,PHD W !!,?10,"<<<< NO DATA FOUND >>>>",! G DQQ
73 S PSDK=""
74 F S PSDK=$O(^TMP("PSDNMKY",$J,PSDK)) Q:(PSDK="")!(PSDOUT) D
75 . S PSDPG=0 D HD,PHD
76 . S PSDS=""
77 . F S PSDS=$O(^TMP("PSDNMKY",$J,PSDK,PSDS)) Q:(PSDS="")!(PSDOUT) D
78 . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
79 . . W !!,"SERVICE/SECTION: ",PSDS
80 . . S PSDN=""
81 . . F S PSDN=$O(^TMP("PSDNMKY",$J,PSDK,PSDS,PSDN)) Q:(PSDN="")!(PSDOUT) D
82 . . . S PSDX=0
83 . . . F S PSDX=$O(^TMP("PSDNMKY",$J,PSDK,PSDS,PSDN,PSDX)) Q:('PSDX)!(PSDOUT) D
84 . . . . S PSDY=$G(^TMP("PSDNMKY",$J,PSDK,PSDS,PSDN,PSDX))
85 . . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
86 . . . . W !,?3,PSDN,?35,$P(PSDY,U,1),?65,$P(PSDY,U,2)
87 . I '$G(PSDOUT),$O(^TMP("PSDNMKY",$J,PSDK))]"" D PAGE
88 ;
89DQQ K ^TMP("PSDNMKY",$J) D ^%ZISC Q
90 ;
91PHD W !,?3,"Name",?35,"Title",?64,"Termination Date"
92 W !,$$REPEAT^XLFSTR("_",IOM)
93 Q
94PAGE ;
95 N DIR,DIRUT,DTOUT,DUOUT,X,Y
96 I IOST?1"C-".E S DIR(0)="E" D ^DIR W !
97 I ($D(DTOUT))!($D(DIRUT)) S PSDOUT=1 Q:$G(PSDOUT)=1
98 Q
99 ;
100EOR ;PSDNMKY - CSM Security Key Print; 18 DEC 02
Note: See TracBrowser for help on using the repository browser.