- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNMKY 3809 printed Feb 18, 2025@23:13:17 Page 2
- PSDNMKY ;DOIFO/CMS - CSM Security Key Print ;18 Dec 02
- +1 ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
- +2 ;Reference to ^XUSEC( supported by IA #1095
- +3 QUIT
- +4 ;
- ST ;CS Monitoring OPTION ENTRY
- +1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,X,Y,ZTIO,ZTSK,ZTRTN,ZTDESC,%,%ZIS
- +2 WRITE !!,?5,"This report lists current holders of the"
- +3 WRITE !,?5,"PSJ RPHARM and/or PSDMGR security keys.",!!
- +4 SET DIR("A")="Okay to Continue"
- SET DIR("B")="No"
- SET DIR(0)="Y"
- DO ^DIR
- +5 IF Y'=1
- WRITE " <No report>",!
- GOTO END
- +6 ;
- +7 KILL IO("Q")
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- WRITE " <No device selected.>"
- GOTO END
- +8 IF $DATA(IO("Q"))
- Begin DoDot:1
- +9 SET ZTRTN="DQ^PSDNMKY"
- SET ZTDESC="CS Monitoring - PSDNMKY"
- +10 DO ^%ZTLOAD
- WRITE !!?5,"TASK #",$GET(ZTSK)," QUEUED!",!
- End DoDot:1
- +11 IF '$DATA(IO("Q"))
- USE IO
- DO DQ
- +12 KILL IOP,IO("Q")
- END QUIT
- +1 ;
- +2 ;
- HD ;Report heading
- +1 NEW PSDH,X,Y,%
- +2 WRITE @IOF,$$CJ^XLFSTR("CS Monitoring - Security Key Report",IOM)
- +3 SET PSDH="SECURITY KEY: "_$SELECT(PSDK="BOTH":"PSDMGR & PSJ RPHARM",1:PSDK)
- +4 WRITE !,$$CJ^XLFSTR(PSDH,IOM)
- +5 WRITE !,"Station: ",$GET(PSDIV),?20,"Report Run Date: "
- +6 SET PSDPG=PSDPG+1
- +7 DO NOW^%DTC
- WRITE $$FMTE^XLFDT(%),?65,"PAGE: ",PSDPG
- +8 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +9 QUIT
- +10 ;
- DQ ;Report Run
- +1 NEW D0,DA,DIC,DIQ,DR
- +2 NEW PSDIV,PSDK,PSDN,PSDO,PSDOUT,PSDPG,PSDS,PSDT,PSDTI,PSDX,PSDY,X,Y,%
- +3 KILL ^TMP("PSDNMKY",$JOB)
- +4 IF IOST?1"C-".E
- WRITE !!,?10,"Compiling report, please wait ..."
- +5 SET PSDX=0
- +6 FOR
- SET PSDX=$ORDER(^XUSEC("PSDMGR",PSDX))
- if 'PSDX
- QUIT
- Begin DoDot:1
- +7 SET PSDN=$GET(^VA(200,PSDX,0))
- IF PSDN']""
- QUIT
- +8 SET DA=PSDX
- SET DR=".01;8;9.2;29"
- SET DIQ="PSDO"
- SET DIQ(0)="E"
- SET DIC="^VA(200,"
- +9 KILL PSDO
- DO EN^DIQ1
- +10 SET PSDN=$GET(PSDO(200,PSDX,.01,"E"))
- +11 SET PSDN=$SELECT(PSDN]"":PSDN,1:"NO NAME (ien="_+PSDX_")")
- +12 SET PSDTI=$GET(PSDO(200,PSDX,8,"E"))
- +13 SET PSDTI=$SELECT(PSDTI]"":PSDTI,1:"UNKNOWN")
- +14 SET PSDT=$GET(PSDO(200,PSDX,9.2,"E"))
- +15 SET PSDS=$GET(PSDO(200,PSDX,29,"E"))
- +16 SET PSDS=$SELECT(PSDS]"":PSDS,1:"UNKNOWN")
- +17 IF $DATA(^XUSEC("PSJ RPHARM",PSDX))
- Begin DoDot:2
- +18 SET ^TMP("PSDNMKY",$JOB,"BOTH",PSDS,$PIECE(PSDN,U,1),PSDX)=PSDTI_U_PSDT
- End DoDot:2
- QUIT
- +19 SET ^TMP("PSDNMKY",$JOB,"PSDMGR",PSDS,$PIECE(PSDN,U,1),PSDX)=PSDTI_U_PSDT
- End DoDot:1
- +20 ;
- +21 SET PSDX=0
- +22 FOR
- SET PSDX=$ORDER(^XUSEC("PSJ RPHARM",PSDX))
- if 'PSDX
- QUIT
- Begin DoDot:1
- +23 SET PSDN=$GET(^VA(200,PSDX,0))
- IF PSDN']""
- QUIT
- +24 SET DA=PSDX
- SET DR=".01;8;9.2;29"
- SET DIQ="PSDO"
- SET DIQ(0)="E"
- SET DIC="^VA(200,"
- +25 KILL PSDO
- DO EN^DIQ1
- +26 SET PSDN=$GET(PSDO(200,PSDX,.01,"E"))
- +27 SET PSDN=$SELECT(PSDN]"":PSDN,1:"NO NAME (ien="_+PSDX_")")
- +28 SET PSDTI=$GET(PSDO(200,PSDX,8,"E"))
- +29 SET PSDTI=$SELECT(PSDTI]"":PSDTI,1:"UNKNOWN")
- +30 SET PSDT=$GET(PSDO(200,PSDX,9.2,"E"))
- +31 SET PSDS=$GET(PSDO(200,PSDX,29,"E"))
- +32 SET PSDS=$SELECT(PSDS]"":PSDS,1:"UNKNOWN")
- +33 IF $DATA(^XUSEC("PSDMGR",PSDX))
- Begin DoDot:2
- +34 SET ^TMP("PSDNMKY",$JOB,"BOTH",PSDS,$PIECE(PSDN,U,1),PSDX)=PSDTI_U_PSDT
- End DoDot:2
- QUIT
- +35 SET ^TMP("PSDNMKY",$JOB,"PSJ RPHARM",PSDS,$PIECE(PSDN,U,1),PSDX)=PSDTI_U_PSDT
- End DoDot:1
- +36 ;
- +37 ;Report print
- +38 SET PSDPG=0
- SET PSDOUT=0
- SET PSDIV=+$$SITE^VASITE
- +39 IF '$DATA(^TMP("PSDNMKY",$JOB))
- SET PSDK="BOTH"
- DO HD
- DO PHD
- WRITE !!,?10,"<<<< NO DATA FOUND >>>>",!
- GOTO DQQ
- +40 SET PSDK=""
- +41 FOR
- SET PSDK=$ORDER(^TMP("PSDNMKY",$JOB,PSDK))
- if (PSDK="")!(PSDOUT)
- QUIT
- Begin DoDot:1
- +42 SET PSDPG=0
- DO HD
- DO PHD
- +43 SET PSDS=""
- +44 FOR
- SET PSDS=$ORDER(^TMP("PSDNMKY",$JOB,PSDK,PSDS))
- if (PSDS="")!(PSDOUT)
- QUIT
- Begin DoDot:2
- +45 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +46 WRITE !!,"SERVICE/SECTION: ",PSDS
- +47 SET PSDN=""
- +48 FOR
- SET PSDN=$ORDER(^TMP("PSDNMKY",$JOB,PSDK,PSDS,PSDN))
- if (PSDN="")!(PSDOUT)
- QUIT
- Begin DoDot:3
- +49 SET PSDX=0
- +50 FOR
- SET PSDX=$ORDER(^TMP("PSDNMKY",$JOB,PSDK,PSDS,PSDN,PSDX))
- if ('PSDX)!(PSDOUT)
- QUIT
- Begin DoDot:4
- +51 SET PSDY=$GET(^TMP("PSDNMKY",$JOB,PSDK,PSDS,PSDN,PSDX))
- +52 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +53 WRITE !,?3,PSDN,?35,$PIECE(PSDY,U,1),?65,$PIECE(PSDY,U,2)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +54 IF '$GET(PSDOUT)
- IF $ORDER(^TMP("PSDNMKY",$JOB,PSDK))]""
- DO PAGE
- End DoDot:1
- +55 ;
- DQQ KILL ^TMP("PSDNMKY",$JOB)
- DO ^%ZISC
- QUIT
- +1 ;
- PHD WRITE !,?3,"Name",?35,"Title",?64,"Termination Date"
- +1 WRITE !,$$REPEAT^XLFSTR("_",IOM)
- +2 QUIT
- PAGE ;
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +2 IF IOST?1"C-".E
- SET DIR(0)="E"
- DO ^DIR
- WRITE !
- +3 IF ($DATA(DTOUT))!($DATA(DIRUT))
- SET PSDOUT=1
- if $GET(PSDOUT)=1
- QUIT
- +4 QUIT
- +5 ;
- EOR ;PSDNMKY - CSM Security Key Print; 18 DEC 02
