| 1 | PSDNMPR ;DOIFO/CMS - CSM Partial Request ;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 | ;
|
|---|
| 8 | ST ;CS Monitoring OPTION ENTRY
|
|---|
| 9 | N PSDODIV,PSDCII,PSDED,PSDFED,PSDFSD,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 with Partial Fill"
|
|---|
| 12 | W !,?5,"request activity within the fill date range entered.",!!
|
|---|
| 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 | S PSDFSD=PSDSD,PSDFED=PSDED
|
|---|
| 16 | W ! D CII^PSDNMU I $G(PSDOUT) G END
|
|---|
| 17 | ;
|
|---|
| 18 | W ! S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
|
|---|
| 19 | I Y'=1 W " <No report>",! G END
|
|---|
| 20 | W !!,?9,"This report should be queued to run during non-peak hours.",!
|
|---|
| 21 | K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
|
|---|
| 22 | I $D(IO("Q")) D
|
|---|
| 23 | .S ZTRTN="DQ^PSDNMPR",ZTDESC="CS Monitoring - PSDNMPR"
|
|---|
| 24 | .S ZTSAVE("PSDODIV(")="",ZTSAVE("PSDCII")="",ZTSAVE("PSDFSD")="",ZTSAVE("PSDFED")=""
|
|---|
| 25 | .D ^%ZTLOAD W !!?5,"TASK #",$G(ZTSK)," QUEUED!",!
|
|---|
| 26 | I '$D(IO("Q")) U IO D DQ
|
|---|
| 27 | K IOP,IO("Q")
|
|---|
| 28 | END Q
|
|---|
| 29 | ;
|
|---|
| 30 | HD ;Report heading
|
|---|
| 31 | N PSDD,PSDL,X,Y,%
|
|---|
| 32 | W @IOF,$$CJ^XLFSTR("CS Monitoring - Partial Request Report",IOM)
|
|---|
| 33 | S PSDL="Outpatient Division(s): "
|
|---|
| 34 | S PSDD=0
|
|---|
| 35 | F S PSDD=$O(PSDODIV(PSDD)) Q:'PSDD S PSDL=PSDL_$P($G(PSDODIV(PSDD)),U,2) I $O(PSDODIV(PSDD)) S PSDL=PSDL_", "
|
|---|
| 36 | W !,$$CJ^XLFSTR(PSDL,IOM)
|
|---|
| 37 | W !,$$CJ^XLFSTR("Fill Date range: "_$P(PSDFSD,U,2)_" thru "_$P(PSDFED,U,2),IOM)
|
|---|
| 38 | S PSDL="Controlled Substance schedule(s): "
|
|---|
| 39 | F PSDD=1:1:4 I $P(PSDCII,",",PSDD) S PSDL=PSDL_$P(PSDCII,",",PSDD) I $P(PSDCII,",",(PSDD+1)) S PSDL=PSDL_", "
|
|---|
| 40 | I +PSDCII W !,$$CJ^XLFSTR(PSDL,IOM)
|
|---|
| 41 | W !,"Division: ",$E($G(PSDIV),1,13),?25,"Report Run Date: "
|
|---|
| 42 | S PSDPG=PSDPG+1
|
|---|
| 43 | D NOW^%DTC W $$FMTE^XLFDT(%),?70,"PAGE: ",PSDPG
|
|---|
| 44 | W !,$$REPEAT^XLFSTR("=",IOM)
|
|---|
| 45 | QUIT
|
|---|
| 46 | ;
|
|---|
| 47 | DQ ;Report Run
|
|---|
| 48 | N PSDA,PSDFD,PSDI,PSDIDT,PSDIV,PSDOUT,PSDP,PSDPG,PSDRG,PSDUZ,PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,Y,%
|
|---|
| 49 | K ^TMP("PSDNMPR",$J)
|
|---|
| 50 | I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
|
|---|
| 51 | S PSDFD=+PSDFSD
|
|---|
| 52 | F S PSDFD=$O(^PSRX("AD",PSDFD)) Q:('PSDFD)!(PSDFD]+PSDFED) D
|
|---|
| 53 | . S PSDX=0
|
|---|
| 54 | . F S PSDX=$O(^PSRX("AD",PSDFD,PSDX)) Q:'PSDX D
|
|---|
| 55 | . . S PSDX0=$G(^PSRX(PSDX,0)) I PSDX0']"" Q
|
|---|
| 56 | . . S PSDX2=$G(^PSRX(PSDX,2))
|
|---|
| 57 | . . I '$D(PSDODIV(+$P(PSDX2,U,9))) Q
|
|---|
| 58 | . . S PSDRG=$G(^PSDRUG(+$P(PSDX0,U,6),0))
|
|---|
| 59 | . . S PSDP=0
|
|---|
| 60 | . . F PSDY=1:1:4 S PSDA=+$P(PSDCII,",",PSDY) I PSDA,$P(PSDRG,U,3)[PSDA S PSDP=1 Q
|
|---|
| 61 | . . I 'PSDP Q
|
|---|
| 62 | . . S PSDI=0
|
|---|
| 63 | . . F S PSDI=$O(^PSRX(PSDX,"A",PSDI)) Q:'PSDI D
|
|---|
| 64 | . . . S PSDA=$G(^PSRX(PSDX,"A",PSDI,0))
|
|---|
| 65 | . . . I $P(PSDA,U,2)'="P" Q
|
|---|
| 66 | . . . S Y=+PSDA D D^DIQ S $P(PSDA,U,1)=Y
|
|---|
| 67 | . . . S PSDUZ=$P($G(^VA(200,+$P(PSDA,U,3),0)),U,1)
|
|---|
| 68 | . . . S ^TMP("PSDNMPR",$J,$S(+$P(PSDX2,U,9):$P($G(^PS(59,+$P(PSDX2,U,9),0)),U,1),1:"UNKNOWN"),$P(PSDRG,U,1),PSDX,PSDI)=$P(PSDX0,U,1)_U_$P(PSDA,U,1)_U_PSDUZ_U_$P(PSDA,U,5)
|
|---|
| 69 | ;
|
|---|
| 70 | PRT ;Report print
|
|---|
| 71 | S PSDPG=0,PSDOUT=0
|
|---|
| 72 | I '$D(^TMP("PSDNMPR",$J)) D G DQQ
|
|---|
| 73 | . S PSDIV="" D HD,PHD
|
|---|
| 74 | . W !!,?10,"<<<< NO DATA FOUND >>>>",!
|
|---|
| 75 | S PSDIV=""
|
|---|
| 76 | F S PSDIV=$O(^TMP("PSDNMPR",$J,PSDIV)) Q:(PSDIV="")!(PSDOUT) D
|
|---|
| 77 | . S PSDPG=0 D HD,PHD
|
|---|
| 78 | . S PSDRG=""
|
|---|
| 79 | . F S PSDRG=$O(^TMP("PSDNMPR",$J,PSDIV,PSDRG)) Q:(PSDRG="")!(PSDOUT) D
|
|---|
| 80 | . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
|
|---|
| 81 | . . W !!,PSDRG
|
|---|
| 82 | . . S PSDX=0
|
|---|
| 83 | . . F S PSDX=$O(^TMP("PSDNMPR",$J,PSDIV,PSDRG,PSDX)) Q:('PSDX)!(PSDOUT) D
|
|---|
| 84 | . . . S PSDA=0
|
|---|
| 85 | . . . F S PSDA=$O(^TMP("PSDNMPR",$J,PSDIV,PSDRG,PSDX,PSDA)) Q:('PSDA)!(PSDOUT) D
|
|---|
| 86 | . . . . S PSDY=$G(^TMP("PSDNMPR",$J,PSDIV,PSDRG,PSDX,PSDA))
|
|---|
| 87 | . . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
|
|---|
| 88 | . . . . W !,$P(PSDY,U,1),?15,$P(PSDY,U,2),?40,$P(PSDY,U,3)
|
|---|
| 89 | . . . . W !,?15,$P(PSDY,U,4)
|
|---|
| 90 | . I '$G(PSDOUT),$O(^TMP("PSDNMPR",$J,PSDIV))]"" D PAGE
|
|---|
| 91 | ;
|
|---|
| 92 | DQQ W ! K PSDCII,PSDFED,PSDFSD,PSDODIV,^TMP("PSDNMPR",$J) D ^%ZISC Q
|
|---|
| 93 | ;
|
|---|
| 94 | PHD ;
|
|---|
| 95 | W !,"RX#",?15,"Activity Log Date",?40,"Initiator of Activity"
|
|---|
| 96 | W !,?15,"Activity Log Comment"
|
|---|
| 97 | W !,$$REPEAT^XLFSTR("_",IOM)
|
|---|
| 98 | Q
|
|---|
| 99 | PAGE ;
|
|---|
| 100 | N DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 101 | I IOST?1"C-".E S DIR(0)="E" D ^DIR W !
|
|---|
| 102 | I ($D(DTOUT))!($D(DIRUT)) S PSDOUT=1 Q:$G(PSDOUT)=1
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | EOR ;PSDNMPR - CSM Partial Request; 18 DEC 02
|
|---|
