source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDNMSP.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1PSDNMSP ;DOIFO/CMS - CSM RX Processed by Same Person ;18 Dec 02
2 ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
3 ;Reference to ^PSDRUG( supported by IA #221
4 ;Reference to ^PS(59 supported by IA #2621
5 ;Reference to ^PSRX( supported by IA #1977
6 Q
7 ;
8ST ;CS Monitoring OPTION ENTRY
9 N PSDODIV,PSDCII,PSDED,PSDOUT,PSDDTN,PSDSD,X,Y,%
10 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,ZTIO,ZTSAVE,ZTSK,ZTRTN,ZTDESC,%ZIS
11 W !!,?5,"This report lists CS prescriptions that were entered,"
12 W !,?5,"finished and released by the same person.",!!
13 W ! D DIV^PSDNMU I '$O(PSDODIV(0))!($G(PSDOUT)) G END
14 S PSDDTN="Fill" D DATE^PSDNMU I '$G(PSDSD)!($G(PSDOUT)) G END
15 W ! D CII^PSDNMU I $G(PSDOUT)!($G(PSDCII)']"") G END
16 ;
17 W ! S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
18 I Y'=1 W " <No report>",! G END
19 W !!,?9,"This report should be queued to run during non-peak hours.",!
20 K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
21 I $D(IO("Q")) D
22 .S ZTRTN="DQ^PSDNMSP",ZTDESC="CS Monitoring - PSDNMSP"
23 .S ZTSAVE("PSDED")="",ZTSAVE("PSDSD")="",ZTSAVE("PSDODIV(")="",ZTSAVE("PSDCII")=""
24 .D ^%ZTLOAD W !!?5,"TASK #",$G(ZTSK)," QUEUED!",!
25 I '$D(IO("Q")) U IO D DQ
26 K IOP,IO("Q")
27END Q
28 ;
29HD ;Report heading
30 N PSDD,PSDL,X,Y,%
31 W @IOF,$$CJ^XLFSTR("CS Monitoring - RX by Same Person Report",IOM)
32 S PSDL="Outpatient Division(s): "
33 S PSDD=0
34 F S PSDD=$O(PSDODIV(PSDD)) Q:'PSDD S PSDL=PSDL_$P($G(PSDODIV(PSDD)),U,2) I $O(PSDODIV(PSDD)) S PSDL=PSDL_", "
35 W !,$$CJ^XLFSTR(PSDL,IOM)
36 W !,$$CJ^XLFSTR("Fill Date range: "_$P(PSDSD,U,2)_" thru "_$P(PSDED,U,2),IOM)
37 S PSDL="Controlled Substance schedule(s): "
38 F PSDD=1:1:4 I $P(PSDCII,",",PSDD) S PSDL=PSDL_$P(PSDCII,",",PSDD) I $P(PSDCII,",",(PSDD+1)) S PSDL=PSDL_", "
39 I +PSDCII W !,$$CJ^XLFSTR(PSDL,IOM)
40 W !,"Station: ",$E($G(PSDIV),1,13),?25,"Report Run Date: "
41 S PSDPG=PSDPG+1
42 D NOW^%DTC W $$FMTE^XLFDT(%),?70,"PAGE: ",PSDPG
43 W !,$$REPEAT^XLFSTR("=",IOM)
44 QUIT
45 ;
46DQ ;Report Run
47 N PSDA,PSDFD,PSDIDT,PSDIV,PSDOUT,PSDP,PSDPG,PSDRG,PSDUZ,PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,Y,%
48 K ^TMP("PSDNMSP",$J)
49 I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
50 S PSDFD=+PSDSD
51 F S PSDFD=$O(^PSRX("AD",PSDFD)) Q:('PSDFD)!(PSDFD]+PSDED) D
52 . S PSDX=0
53 . F S PSDX=$O(^PSRX("AD",PSDFD,PSDX)) Q:'PSDX D
54 . . S PSDX0=$G(^PSRX(PSDX,0)) I PSDX0']"" Q
55 . . S PSDX2=$G(^PSRX(PSDX,2))
56 . . I '$D(PSDODIV(+$P(PSDX2,U,9))) Q
57 . . S PSDRG=$G(^PSDRUG(+$P(PSDX0,U,6),0))
58 . . S PSDP=0
59 . . F PSDY=1:1:4 S PSDA=+$P(PSDCII,",",PSDY) I PSDA,$P(PSDRG,U,3)[PSDA S PSDP=1 Q
60 . . I 'PSDP Q
61 . . S PSDUZ=+$P(PSDX0,U,16) I 'PSDUZ Q
62 . . I PSDUZ'=+$P(PSDX2,U,3) Q
63 . . S PSDXOR1=$G(^PSRX(PSDX,"OR1"))
64 . . I PSDUZ'=+$P(PSDXOR1,U,5) Q
65 . . S Y=PSDFD D D^DIQ S PSDIDT=Y
66 . . S ^TMP("PSDNMSP",$J,$S(+$P(PSDX2,U,9):$P($G(^PS(59,+$P(PSDX2,U,9),0)),U,1),1:"UNKNOWN"),$P($G(^VA(200,+PSDUZ,0)),U,1),PSDX)=$P(PSDX0,U,1)_U_PSDIDT_U_$P(PSDRG,U,1)
67 ;
68PRT ;Report print
69 S PSDPG=0,PSDOUT=0
70 I '$D(^TMP("PSDNMSP",$J)) D G DQQ
71 . S PSDIV="" S PSDPG=0 D HD,PHD
72 . W !!,?10,"<<<< NO DATA FOUND >>>>",!
73 S PSDIV=""
74 F S PSDIV=$O(^TMP("PSDNMSP",$J,PSDIV)) Q:(PSDIV="")!(PSDOUT) D
75 . S PSDPG=0 D HD,PHD
76 . S PSDUZ=""
77 . F S PSDUZ=$O(^TMP("PSDNMSP",$J,PSDIV,PSDUZ)) Q:(PSDUZ="")!(PSDOUT) D
78 . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
79 . . W !!,PSDUZ
80 . . S PSDX=0
81 . . F S PSDX=$O(^TMP("PSDNMSP",$J,PSDIV,PSDUZ,PSDX)) Q:('PSDX)!(PSDOUT) D
82 . . . S PSDY=$G(^TMP("PSDNMSP",$J,PSDIV,PSDUZ,PSDX))
83 . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
84 . . . W !,$P(PSDY,U,1),?25,$P(PSDY,U,2),?40,$P(PSDY,U,3)
85 . I '$G(PSDOUT),$O(^TMP("PSDNMSP",$J,PSDIV))]"" D PAGE
86 ;
87DQQ W ! K PSDCII,PSDED,PSDODIV,PSDSD,^TMP("PSDNMSP",$J) D ^%ZISC Q
88 ;
89PHD W !,"Pharmacy User"
90 W !,"RX#",?25,"Fill Date",?40,"Drug Name"
91 W !,$$REPEAT^XLFSTR("_",IOM)
92 Q
93PAGE ;
94 N DIR,DIRUT,DTOUT,DUOUT,X,Y
95 I IOST?1"C-".E S DIR(0)="E" D ^DIR W !
96 I ($D(DTOUT))!($D(DIRUT)) S PSDOUT=1 Q:$G(PSDOUT)=1
97 Q
98 ;
99EOR ;PSDNMSP - CSM RX Processed by Same Person; 18 DEC 02
Note: See TracBrowser for help on using the repository browser.