- PSDNMWE ;DOIFO/CMS - CSM No Visits within 12 Months ;18 Dec 02
- ;;3.0; CONTROLLED SUBSTANCES;**41,42**;13 Feb 97
- ;Reference to ^DPT( supported by IA #10035
- ;Reference to ^PSDRUG( supported by IA #2621
- ;Reference to ^PSRX( supported by IA #1977
- Q
- ;
- ST ;CS Monitoring OPTION ENTRY
- N PSDODIV,PSDCII,PSDDTN,PSDED,PSDISA,PSDISB,PSDOUT,PSDSD,X,Y,%,%ZIS
- N DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,ZTIO,ZTSAVE,ZTSK,ZTRTN,ZTDESC
- W !!,?5,"This report lists released RXs without a visit within 12 months of the"
- W !,?5,"RX Release date. Excluding RXs released on the same day as a discharge"
- W !,?5,"and within a user defined discharge date range.",!!
- W ! D DIV^PSDNMU I '$O(PSDODIV(0))!($G(PSDOUT)) G END
- S PSDDTN="RX Release" D DATE^PSDNMU I '$G(PSDSD)!($G(PSDOUT)) G END
- W ! D DISD^PSDNMU I $G(PSDOUT) G END
- W ! S DIR("A")="Screen for controlled substance RXs"
- S DIR("B")="Yes",DIR(0)="Y" D ^DIR K DIR I X="^"!($D(DTOUT)) G END
- I Y=1 W ! D CII^PSDNMU I '+$G(PSDCII)!($G(PSDOUT)) G END
- I Y'=1 S PSDCII=""
- ;
- W ! S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
- I Y'=1 W " <No report>",! G END
- W !!,?9,"This report should be queued to run during non-peak hours.",!
- K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
- I $D(IO("Q")) D
- .S ZTRTN="DQ^PSDNMWE",ZTDESC="CS Monitoring - PSDNMWE"
- .S ZTSAVE("PSDSD")="",ZTSAVE("PSDODIV(")="",ZTSAVE("PSDCII")="",ZTSAVE("PSDED")="",ZTSAVE("PSDISA")="",ZTSAVE("PSDISB")=""
- .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 PSDD,PSDL,X,Y,%
- W @IOF,$$CJ^XLFSTR("CS Monitoring - No Visits within 12 months of RX Release Report",IOM)
- S PSDL="Outpatient Division(s): "
- S PSDD=0
- F S PSDD=$O(PSDODIV(PSDD)) Q:'PSDD S PSDL=PSDL_$P($G(PSDODIV(PSDD)),U,2) I $O(PSDODIV(PSDD)) S PSDL=PSDL_", "
- W !,$$CJ^XLFSTR(PSDL,IOM)
- W !,$$CJ^XLFSTR("Prescriptions released: "_$P(PSDSD,U,2)_" thru "_$P(PSDED,U,2),IOM)
- I $G(PSDISA)!($G(PSDISB)) D
- . S PSDL="Exclude RXs released: "
- . I $G(PSDISB) S PSDL=PSDL_+PSDISB_" day(s) before "
- . I $G(PSDISA) S PSDL=PSDL_+PSDISA_" day(s) after "
- . S PSDL=PSDL_"a discharge date"
- . W !,$$CJ^XLFSTR(PSDL,IOM)
- S PSDL="Controlled Substance schedule(s): "
- F PSDD=1:1:4 I $P(PSDCII,",",PSDD) S PSDL=PSDL_$P(PSDCII,",",PSDD) I $P(PSDCII,",",(PSDD+1)) S PSDL=PSDL_", "
- I +PSDCII W !,$$CJ^XLFSTR(PSDL,IOM)
- W !,"Division: ",$E($G(PSDIV),1,13),?25,"Report Run Date: "
- S PSDPG=PSDPG+1
- D NOW^%DTC W $$FMTE^XLFDT(%),?70,"PAGE: ",PSDPG
- W !,$$REPEAT^XLFSTR("=",IOM)
- QUIT
- ;
- DQ ;Report Run
- N D0,DA,DFN,DIC,DIQ,DR
- N PSDA,PSDD,PSDFD,PSDI,PSDIDT,PSDIV,PSDO,PSDOUT,PSDP,PSDPG,PSDS,PSDRG
- N PSDUZ,PSDY,PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,X1,X2,Y,%,%DT
- K ^TMP("PSDNMWE",$J)
- I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
- S PSDFD=+PSDSD
- F S PSDFD=$O(^PSRX("AL",PSDFD)) Q:('PSDFD)!(PSDFD]+PSDED) D
- . S PSDX=0
- . F S PSDX=$O(^PSRX("AL",PSDFD,PSDX)) Q:'PSDX D
- . . D KVA^VADPT
- . . S PSDX0=$G(^PSRX(PSDX,0)) I PSDX0']"" Q
- . . S PSDX2=$G(^PSRX(PSDX,2))
- . . I '$D(PSDODIV(+$P(PSDX2,U,9))) Q
- . . S PSDRG=$G(^PSDRUG(+$P(PSDX0,U,6),0))
- . . I +$G(PSDCII) S PSDP=0 D I 'PSDP Q
- . . . F PSDY=1:1:4 S PSDA=$P(PSDCII,",",PSDY) I PSDA,$P(PSDRG,U,3)[PSDA S PSDP=1 Q
- . . I +$G(PSDCII),'PSDP Q
- . . ;Check Discharge Date
- . . S DFN=+$P(PSDX0,U,2) D DEM^VADPT
- . . S VAIP("D")=+$P(PSDFD,".",1),PSDP=0
- . . I $D(^TMP("PSDNMWE",$J,1,DFN,VAIP("D"))) Q
- . . D IN5^VADPT D I $G(PSDP) Q
- . . . I +$G(VAIP(17,2))[VAIP("D") S ^TMP("PSDNMWE",$J,1,DFN,VAIP("D"))="" S PSDP=1 Q
- . . . I +$G(VAIP(17,2)),$G(PSDISA) D I $G(PSDP) Q
- . . . . S X1=+$G(VAIP(17,2)),X2=+PSDISA D C^%DTC S PSDD=X
- . . . . I VAIP("D")'>PSDD S PSDP=1 Q
- . . . I +$G(VAIP(17,2)),$G(PSDISB) D I $G(PSDP) Q
- . . . . S X1=+$G(VAIP(17,2)),X2=-PSDISB D C^%DTC S PSDD=X
- . . . . I VAIP("D")'<PSDD S PSDP=1 Q
- . . ;
- . . ;Check Visits within 12 months
- . . S PSDD="",X1=+PSDFD,X2=-365 D C^%DTC S PSDY=X
- . . K VASD S VASD("W")=1,VASD("F")=PSDY,VASD("T")=PSDFD
- . . D SDA^VADPT
- . . S PSDY=0
- . . F S PSDY=$O(^UTILITY("VASD",$J,PSDY)) Q:'PSDY D
- . . . S PSDI=$G(^UTILITY("VASD",$J,PSDY,"I"))
- . . . I $P(PSDI,U,3)="" K PSDP Q
- . . . S PSDP=1
- . . I $G(PSDP)=1!('$O(^UTILITY("VASD",$J,0))) D
- . . . I +$G(VADM(6)),+$G(VADM(6))']VAIP("D") S PSDD=$P($G(VADM(6)),U,2)
- . . . S Y=+PSDFD D D^DIQ S PSDA=Y
- . . . S PSDUZ=$P($G(^DPT(DFN,0)),U,1)_" ("_$E(VA("PID"),5,12)_")"
- . . . S DIC="^PSRX(",DA=PSDX,DR="3;20",DIQ(0)="E",DIQ="PSDO"
- . . . K PSDO D EN^DIQ1
- . . . S ^TMP("PSDNMWE",$J,$S($G(PSDO(52,PSDX,20,"E"))]"":$G(PSDO(52,PSDX,20,"E")),1:"UNKNOWN"),$S($G(PSDO(52,PSDX,3,"E"))]"":$G(PSDO(52,PSDX,3,"E")),1:"UNKNOWN"),PSDUZ,PSDX)=$P(PSDX0,U,1)_U_PSDA_U_$P(PSDRG,U,1)_U_$G(PSDD)
- D KVA^VADPT
- ;
- PRT ;Report print
- S PSDPG=0,PSDOUT=0
- I '$D(^TMP("PSDNMWE",$J)) D G DQQ
- . S PSDIV="",PSDPG=0 D HD,PHD
- . W !!,?10,"<<<< NO DATA FOUND >>>>",!
- S PSDIV=""
- F S PSDIV=$O(^TMP("PSDNMWE",$J,PSDIV)) Q:(PSDIV="")!(PSDOUT) D
- . S PSDPG=0 D HD,PHD
- . S PSDS=""
- . F S PSDS=$O(^TMP("PSDNMWE",$J,PSDIV,PSDS)) Q:(PSDS="")!(PSDOUT) D
- . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
- . . W !!,?12,"RX PATIENT STATUS: ",PSDS
- . . S PSDRG=""
- . . F S PSDRG=$O(^TMP("PSDNMWE",$J,PSDIV,PSDS,PSDRG)) Q:(PSDRG="")!(PSDOUT) D
- . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
- . . . W !!,"PATIENT NAME: ",PSDRG
- . . . S PSDX=0
- . . . F S PSDX=$O(^TMP("PSDNMWE",$J,PSDIV,PSDS,PSDRG,PSDX)) Q:('PSDX)!(PSDOUT) D
- . . . . S PSDY=$G(^TMP("PSDNMWE",$J,PSDIV,PSDS,PSDRG,PSDX))
- . . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
- . . . . W !,$P(PSDY,U,1),?12,$P(PSDY,U,2),?40,$P(PSDY,U,3)
- . . . . I $P(PSDY,U,4)]"" W !,?12,"*Date of Death "_$P(PSDY,U,4)_" before RX Release Date!"
- . I '$G(PSDOUT),$O(^TMP("PSDNMWE",$J,PSDIV))]"" D PAGE
- ;
- DQQ W ! K PSDCII,PSDODIV,PSDSD,PSDED,PSDISA,PSDISB,^TMP("PSDNMWE",$J) D ^%ZISC Q
- ;
- PHD ;
- W !,"RX#",?12,"Release Date",?40,"Drug"
- 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 ;PSDNMWE - CSM No Visits in 12 Months; 18 DEC 02
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNMWE 6277 printed Mar 13, 2025@20:51:38 Page 2
- PSDNMWE ;DOIFO/CMS - CSM No Visits within 12 Months ;18 Dec 02
- +1 ;;3.0; CONTROLLED SUBSTANCES;**41,42**;13 Feb 97
- +2 ;Reference to ^DPT( supported by IA #10035
- +3 ;Reference to ^PSDRUG( supported by IA #2621
- +4 ;Reference to ^PSRX( supported by IA #1977
- +5 QUIT
- +6 ;
- ST ;CS Monitoring OPTION ENTRY
- +1 NEW PSDODIV,PSDCII,PSDDTN,PSDED,PSDISA,PSDISB,PSDOUT,PSDSD,X,Y,%,%ZIS
- +2 NEW DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,ZTIO,ZTSAVE,ZTSK,ZTRTN,ZTDESC
- +3 WRITE !!,?5,"This report lists released RXs without a visit within 12 months of the"
- +4 WRITE !,?5,"RX Release date. Excluding RXs released on the same day as a discharge"
- +5 WRITE !,?5,"and within a user defined discharge date range.",!!
- +6 WRITE !
- DO DIV^PSDNMU
- IF '$ORDER(PSDODIV(0))!($GET(PSDOUT))
- GOTO END
- +7 SET PSDDTN="RX Release"
- DO DATE^PSDNMU
- IF '$GET(PSDSD)!($GET(PSDOUT))
- GOTO END
- +8 WRITE !
- DO DISD^PSDNMU
- IF $GET(PSDOUT)
- GOTO END
- +9 WRITE !
- SET DIR("A")="Screen for controlled substance RXs"
- +10 SET DIR("B")="Yes"
- SET DIR(0)="Y"
- DO ^DIR
- KILL DIR
- IF X="^"!($DATA(DTOUT))
- GOTO END
- +11 IF Y=1
- WRITE !
- DO CII^PSDNMU
- IF '+$GET(PSDCII)!($GET(PSDOUT))
- GOTO END
- +12 IF Y'=1
- SET PSDCII=""
- +13 ;
- +14 WRITE !
- SET DIR("A")="Okay to Continue"
- SET DIR("B")="No"
- SET DIR(0)="Y"
- DO ^DIR
- +15 IF Y'=1
- WRITE " <No report>",!
- GOTO END
- +16 WRITE !!,?9,"This report should be queued to run during non-peak hours.",!
- +17 KILL IO("Q")
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- WRITE " <No device selected.>"
- GOTO END
- +18 IF $DATA(IO("Q"))
- Begin DoDot:1
- +19 SET ZTRTN="DQ^PSDNMWE"
- SET ZTDESC="CS Monitoring - PSDNMWE"
- +20 SET ZTSAVE("PSDSD")=""
- SET ZTSAVE("PSDODIV(")=""
- SET ZTSAVE("PSDCII")=""
- SET ZTSAVE("PSDED")=""
- SET ZTSAVE("PSDISA")=""
- SET ZTSAVE("PSDISB")=""
- +21 DO ^%ZTLOAD
- WRITE !!?5,"TASK #",$GET(ZTSK)," QUEUED!",!
- End DoDot:1
- +22 IF '$DATA(IO("Q"))
- USE IO
- DO DQ
- +23 KILL IOP,IO("Q")
- END QUIT
- +1 ;
- HD ;Report heading
- +1 NEW PSDD,PSDL,X,Y,%
- +2 WRITE @IOF,$$CJ^XLFSTR("CS Monitoring - No Visits within 12 months of RX Release Report",IOM)
- +3 SET PSDL="Outpatient Division(s): "
- +4 SET PSDD=0
- +5 FOR
- SET PSDD=$ORDER(PSDODIV(PSDD))
- if 'PSDD
- QUIT
- SET PSDL=PSDL_$PIECE($GET(PSDODIV(PSDD)),U,2)
- IF $ORDER(PSDODIV(PSDD))
- SET PSDL=PSDL_", "
- +6 WRITE !,$$CJ^XLFSTR(PSDL,IOM)
- +7 WRITE !,$$CJ^XLFSTR("Prescriptions released: "_$PIECE(PSDSD,U,2)_" thru "_$PIECE(PSDED,U,2),IOM)
- +8 IF $GET(PSDISA)!($GET(PSDISB))
- Begin DoDot:1
- +9 SET PSDL="Exclude RXs released: "
- +10 IF $GET(PSDISB)
- SET PSDL=PSDL_+PSDISB_" day(s) before "
- +11 IF $GET(PSDISA)
- SET PSDL=PSDL_+PSDISA_" day(s) after "
- +12 SET PSDL=PSDL_"a discharge date"
- +13 WRITE !,$$CJ^XLFSTR(PSDL,IOM)
- End DoDot:1
- +14 SET PSDL="Controlled Substance schedule(s): "
- +15 FOR PSDD=1:1:4
- IF $PIECE(PSDCII,",",PSDD)
- SET PSDL=PSDL_$PIECE(PSDCII,",",PSDD)
- IF $PIECE(PSDCII,",",(PSDD+1))
- SET PSDL=PSDL_", "
- +16 IF +PSDCII
- WRITE !,$$CJ^XLFSTR(PSDL,IOM)
- +17 WRITE !,"Division: ",$EXTRACT($GET(PSDIV),1,13),?25,"Report Run Date: "
- +18 SET PSDPG=PSDPG+1
- +19 DO NOW^%DTC
- WRITE $$FMTE^XLFDT(%),?70,"PAGE: ",PSDPG
- +20 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +21 QUIT
- +22 ;
- DQ ;Report Run
- +1 NEW D0,DA,DFN,DIC,DIQ,DR
- +2 NEW PSDA,PSDD,PSDFD,PSDI,PSDIDT,PSDIV,PSDO,PSDOUT,PSDP,PSDPG,PSDS,PSDRG
- +3 NEW PSDUZ,PSDY,PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,X1,X2,Y,%,%DT
- +4 KILL ^TMP("PSDNMWE",$JOB)
- +5 IF IOST?1"C-".E
- WRITE !!,?10,"Compiling report, please wait ..."
- +6 SET PSDFD=+PSDSD
- +7 FOR
- SET PSDFD=$ORDER(^PSRX("AL",PSDFD))
- if ('PSDFD)!(PSDFD]+PSDED)
- QUIT
- Begin DoDot:1
- +8 SET PSDX=0
- +9 FOR
- SET PSDX=$ORDER(^PSRX("AL",PSDFD,PSDX))
- if 'PSDX
- QUIT
- Begin DoDot:2
- +10 DO KVA^VADPT
- +11 SET PSDX0=$GET(^PSRX(PSDX,0))
- IF PSDX0']""
- QUIT
- +12 SET PSDX2=$GET(^PSRX(PSDX,2))
- +13 IF '$DATA(PSDODIV(+$PIECE(PSDX2,U,9)))
- QUIT
- +14 SET PSDRG=$GET(^PSDRUG(+$PIECE(PSDX0,U,6),0))
- +15 IF +$GET(PSDCII)
- SET PSDP=0
- Begin DoDot:3
- +16 FOR PSDY=1:1:4
- SET PSDA=$PIECE(PSDCII,",",PSDY)
- IF PSDA
- IF $PIECE(PSDRG,U,3)[PSDA
- SET PSDP=1
- QUIT
- End DoDot:3
- IF 'PSDP
- QUIT
- +17 IF +$GET(PSDCII)
- IF 'PSDP
- QUIT
- +18 ;Check Discharge Date
- +19 SET DFN=+$PIECE(PSDX0,U,2)
- DO DEM^VADPT
- +20 SET VAIP("D")=+$PIECE(PSDFD,".",1)
- SET PSDP=0
- +21 IF $DATA(^TMP("PSDNMWE",$JOB,1,DFN,VAIP("D")))
- QUIT
- +22 DO IN5^VADPT
- Begin DoDot:3
- +23 IF +$GET(VAIP(17,2))[VAIP("D")
- SET ^TMP("PSDNMWE",$JOB,1,DFN,VAIP("D"))=""
- SET PSDP=1
- QUIT
- +24 IF +$GET(VAIP(17,2))
- IF $GET(PSDISA)
- Begin DoDot:4
- +25 SET X1=+$GET(VAIP(17,2))
- SET X2=+PSDISA
- DO C^%DTC
- SET PSDD=X
- +26 IF VAIP("D")'>PSDD
- SET PSDP=1
- QUIT
- End DoDot:4
- IF $GET(PSDP)
- QUIT
- +27 IF +$GET(VAIP(17,2))
- IF $GET(PSDISB)
- Begin DoDot:4
- +28 SET X1=+$GET(VAIP(17,2))
- SET X2=-PSDISB
- DO C^%DTC
- SET PSDD=X
- +29 IF VAIP("D")'<PSDD
- SET PSDP=1
- QUIT
- End DoDot:4
- IF $GET(PSDP)
- QUIT
- End DoDot:3
- IF $GET(PSDP)
- QUIT
- +30 ;
- +31 ;Check Visits within 12 months
- +32 SET PSDD=""
- SET X1=+PSDFD
- SET X2=-365
- DO C^%DTC
- SET PSDY=X
- +33 KILL VASD
- SET VASD("W")=1
- SET VASD("F")=PSDY
- SET VASD("T")=PSDFD
- +34 DO SDA^VADPT
- +35 SET PSDY=0
- +36 FOR
- SET PSDY=$ORDER(^UTILITY("VASD",$JOB,PSDY))
- if 'PSDY
- QUIT
- Begin DoDot:3
- +37 SET PSDI=$GET(^UTILITY("VASD",$JOB,PSDY,"I"))
- +38 IF $PIECE(PSDI,U,3)=""
- KILL PSDP
- QUIT
- +39 SET PSDP=1
- End DoDot:3
- +40 IF $GET(PSDP)=1!('$ORDER(^UTILITY("VASD",$JOB,0)))
- Begin DoDot:3
- +41 IF +$GET(VADM(6))
- IF +$GET(VADM(6))']VAIP("D")
- SET PSDD=$PIECE($GET(VADM(6)),U,2)
- +42 SET Y=+PSDFD
- DO D^DIQ
- SET PSDA=Y
- +43 SET PSDUZ=$PIECE($GET(^DPT(DFN,0)),U,1)_" ("_$EXTRACT(VA("PID"),5,12)_")"
- +44 SET DIC="^PSRX("
- SET DA=PSDX
- SET DR="3;20"
- SET DIQ(0)="E"
- SET DIQ="PSDO"
- +45 KILL PSDO
- DO EN^DIQ1
- +46 SET ^TMP("PSDNMWE",$JOB,$SELECT($GET(PSDO(52,PSDX,20,"E"))]"":$GET(PSDO(52,PSDX,20,"E")),1:"UNKNOWN"),$SELECT($GET(PSDO(52,PSDX,3,"E"))]"":$GET(PSDO(52,PSDX,3,"E")),1:"UNKNOWN"),PSDUZ,PSDX)=$PIECE(PSDX0,U,1)_U_PSDA_U_$PI
- ECE(PSDRG,U,1)_U_$GET(PSDD)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +47 DO KVA^VADPT
- +48 ;
- PRT ;Report print
- +1 SET PSDPG=0
- SET PSDOUT=0
- +2 IF '$DATA(^TMP("PSDNMWE",$JOB))
- Begin DoDot:1
- +3 SET PSDIV=""
- SET PSDPG=0
- DO HD
- DO PHD
- +4 WRITE !!,?10,"<<<< NO DATA FOUND >>>>",!
- End DoDot:1
- GOTO DQQ
- +5 SET PSDIV=""
- +6 FOR
- SET PSDIV=$ORDER(^TMP("PSDNMWE",$JOB,PSDIV))
- if (PSDIV="")!(PSDOUT)
- QUIT
- Begin DoDot:1
- +7 SET PSDPG=0
- DO HD
- DO PHD
- +8 SET PSDS=""
- +9 FOR
- SET PSDS=$ORDER(^TMP("PSDNMWE",$JOB,PSDIV,PSDS))
- if (PSDS="")!(PSDOUT)
- QUIT
- Begin DoDot:2
- +10 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +11 WRITE !!,?12,"RX PATIENT STATUS: ",PSDS
- +12 SET PSDRG=""
- +13 FOR
- SET PSDRG=$ORDER(^TMP("PSDNMWE",$JOB,PSDIV,PSDS,PSDRG))
- if (PSDRG="")!(PSDOUT)
- QUIT
- Begin DoDot:3
- +14 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +15 WRITE !!,"PATIENT NAME: ",PSDRG
- +16 SET PSDX=0
- +17 FOR
- SET PSDX=$ORDER(^TMP("PSDNMWE",$JOB,PSDIV,PSDS,PSDRG,PSDX))
- if ('PSDX)!(PSDOUT)
- QUIT
- Begin DoDot:4
- +18 SET PSDY=$GET(^TMP("PSDNMWE",$JOB,PSDIV,PSDS,PSDRG,PSDX))
- +19 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +20 WRITE !,$PIECE(PSDY,U,1),?12,$PIECE(PSDY,U,2),?40,$PIECE(PSDY,U,3)
- +21 IF $PIECE(PSDY,U,4)]""
- WRITE !,?12,"*Date of Death "_$PIECE(PSDY,U,4)_" before RX Release Date!"
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +22 IF '$GET(PSDOUT)
- IF $ORDER(^TMP("PSDNMWE",$JOB,PSDIV))]""
- DO PAGE
- End DoDot:1
- +23 ;
- DQQ WRITE !
- KILL PSDCII,PSDODIV,PSDSD,PSDED,PSDISA,PSDISB,^TMP("PSDNMWE",$JOB)
- DO ^%ZISC
- QUIT
- +1 ;
- PHD ;
- +1 WRITE !,"RX#",?12,"Release Date",?40,"Drug"
- +2 WRITE !,$$REPEAT^XLFSTR("_",IOM)
- +3 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 ;PSDNMWE - CSM No Visits in 12 Months; 18 DEC 02
