source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDNDIS.m@ 836

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1SDNDIS ;ALB/TMP - CHECK FOR AND DISCHARGE PATIENTS EXCEEDING MAX # OF NO SHOWS ; 8-14-86
2 ;;5.3;Scheduling;;Aug 13, 1993
3DIS W !!,".. Searching for patients who have exceeded the maximum # of no-shows allowed ..",! K SDCTR
4 K FSW F A=0:0 S A=$N(^UTILITY($J,"CL",A)) Q:A'>0 F B=0:0 S B=$N(^UTILITY($J,"CL",A,B)) Q:B'>0 I $D(^DPT(A,0)) F A0=0:0 S A0=$N(^UTILITY($J,"CL",A,B,A0)),GDATE=A0,SC=B Q:A0<0 K A1 D NUM
5 Q:'$D(SDCTR) F I=0:0 S I=$N(SDCTR(I)) Q:I'>0 W !!,$S($D(^SC(I,0)):$P(^(0),"^",1),1:" "),?35,": ",SDCTR(I)," patient",$S(SDCTR(I)>1:"s ",1:" "),"exceeded max # of NO SHOWS"
6 W !!,"No patients discharged ",!!,"The records of the patients who have exceeded the maximum NO SHOW limit",!,"will need to be reviewed for possible discharge from the specified clinics !"
7 W ! K SDCTR Q
8NUM D DISCH S (SDCONS,POP)=0,SDCMAX=$S($D(^SC(SC,"SDP")):+^("SDP"),1:"") Q:SDCMAX']""
9 I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
10 I $D(A1),A1 F A2=A1:0 S A2=$N(^DPT(+A,"S",A2)) Q:A2'>0!((A2\1)>DT)!(SDCONS>SDCMAX) I $D(^(+A2,0)),+^(0)=SC S SDZSC=^(0),SDCONS=$S($P(SDZSC,U,2)["N":SDCONS+1,1:0)
11 I SDCONS>SDCMAX S SDC=SC,SDCTR(SDC)=$S($D(SDCTR(SDC)):SDCTR(SDC)+1,1:1)
12 I W *7,!,"Please note that this patient -- ",$P($P(^DPT(+A,0),U),",",2)," ",$P($P(^(0),U),",",1)," --SSN ",$P(^(0),U,9),!,"has exceeded the maximum # of NO SHOWS",!,"in the following clinic : ",$P(^SC(SDC,0),U,1),!! H 5
13 Q
14DISCH S SDC=SC I $D(^SC(SC,"SL")),+$P(^("SL"),"^",5) S SDC=$P(^("SL"),"^",5)
15 K SDIS F I=0:0 S I=$N(^DPT(+A,"DE","B",SDC,I)) Q:I'>0!($D(SDIS)) I $D(^DPT(+A,"DE",I)) F I1=0:0 S I1=$N(^DPT(+A,"DE",I,1,I1)) Q:I1'>0 S SDIS=$S($P(^(I1,0),"^",3)']"":1,1:0) I SDIS,$P(^(0),U) S A1=$P(^(0),U) Q
16 Q
Note: See TracBrowser for help on using the repository browser.