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 Dec 13, 2024@01:46:57 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
