source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCIAL.m@ 691

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1SDCIAL ;ALB/TMP - INPATIENT APPOINTMENT LIST ; 16 JAN 86
2 ;;5.3;Scheduling;**32,406**;Aug 13, 1993
3 S DIV="",SDTT=0 D DIV^SDUTL I $T S DIC("A")="INPATIENT APPOINTMENT LIST FOR WHICH DIVISION:" D ASK^SDDIV Q:Y<0
4RD R !,"FOR WARD (TYPE 'ALL' FOR ALL WARDS): ",X:DTIME Q:"^"[X I X?.E1"?" W !,"ENTER A WARD NAME OR ALL FOR ALL WARDS"
5 S X=$$UP^XLFSTR(X)
6 I X="ALL" S SDW=X G RD1
7 S DIC="^DIC(42,",DIC(0)="EQ"
8 D ^DIC Q:X=""!(X["^") G:Y<0 RD S SDW=+Y
9RD1 D DATE^SDUTL G:POP END I BEGDATE<DT W *7,!,"Start date must be in the future" G RD1
10 S VAR="DIV^SDW^BEGDATE^ENDDATE",VAL=DIV_"^"_SDW_"^"_BEGDATE_"^"_ENDDATE,PGM="START^SDCIAL"
11 D ZIS^DGUTQ G:POP END
12START K ^UTILITY($J),^TMP($J,"SDAMA301"),^TMP($J,"SDAMA301C") U IO I '$D(DT) D DT^SDUTL
13 N SDLIST,SDCOUNT S SDCOUNT=0
14 S (SDEND,SD1)=0,SDTT=$S($E(IOST,1,2)="C-"&(IOSL<66):1,1:0)
15 I SDW'="ALL" S I=$P(^DIC(42,SDW,0),"^",1) D PT D DFN D WRT Q
16 S I=0 F S I=$O(^DPT("ACN",I)) Q:I="" D PT
17 D DFN,WRT
18 Q
19PT ;build patient list
20 S I2="" F S I2=$O(^DPT("ACN",I,I2)) Q:I2'>0 I $D(^DPT(I2,0)) S SDLIST(I2)=""
21 Q
22DFN ;retrieve appt data for list of patients
23 I $D(SDLIST)'>1 Q
24 N SDARRAY,SDDFN,SDWARD,SDAPPT,SDCL,SDLAB,SDXRAY,SDEKG,SDOTHER
25 S SDARRAY(1)=BEGDATE_";"_ENDDATE,SDARRAY(3)="I;R",SDARRAY("FLDS")="1;2;6;19;20;21",SDARRAY(4)="SDLIST("
26 S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY) I SDCOUNT<1 Q
27 ;re-sort output by clinic, then patient
28 S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D
29 . S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",SDDFN,SDCL)) Q:SDCL="" D
30 .. M ^TMP($J,"SDAMA301C",SDCL,SDDFN)=^TMP($J,"SDAMA301",SDDFN,SDCL)
31 I DIV'="" D
32 . ;remove appts if clinic is not in selected division
33 . S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301C",SDCL)) Q:SDCL="" I $P(^SC(SDCL,0),"^",15)'=DIV K ^TMP($J,"SDAMA301C",SDCL)
34 ;get appt data and add to ^UTILITY
35 S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301C",SDCL)) Q:SDCL="" D
36 . S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301C",SDCL,SDDFN)) Q:SDDFN="" D
37 .. S SDAPPT=0 F S SDAPPT=$O(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT)) Q:SDAPPT="" D
38 ... S SDWARD=$P($G(^DPT(SDDFN,.1)),"^",1)
39 ... S SDLAB=$P(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT),"^",21)
40 ... S SDXRAY=$P(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT),"^",20)
41 ... S SDEKG=$P(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT),"^",19)
42 ... S SDOTHER=$P($G(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT,"C")),"^",1)
43 ... ;mimic DPT "S" node, but also add 'other' to end (6th piece) for future use:
44 ... I $G(SDWARD)]"" S ^UTILITY($J,SDWARD,SDAPPT\1,SDDFN,"."_$P(SDAPPT,".",2))=SDCL_"^^"_$G(SDLAB)_"^"_$G(SDXRAY)_"^"_$G(SDEKG)_"^"_$G(SDOTHER)
45 Q
46WRT I SDCOUNT<0 W @IOF,?29,"INPATIENT APPOINTMENT LIST",! X "F A=1:1:IOM W ""-""" W !!,$$SDAPIERR^SDAMUTDT() D END Q
47 S I="" I $O(^UTILITY($J,I))']"" W @IOF,?29,"INPATIENT APPOINTMENT LIST",! X "F A=1:1:IOM W ""-""" W !!,"NO MATCHES FOUND!" G END
48 S (SDPG,I)=0 F S I=$O(^UTILITY($J,I)) Q:I=""!(SDEND) D HD Q:SDEND S I2=0 F S I2=$O(^UTILITY($J,I,I2)) Q:I2="" D:($Y+4)>IOSL HD Q:SDEND D APPT Q:SDEND
49 G END
50APPT W:SD2 !! D:($Y+6)>IOSL HD Q:SDEND S Y=I2 D DTS^SDUTL W !,Y S SD2=1
51 S I3=0 F S I3=$O(^UTILITY($J,I,I2,I3)) Q:I3=""!(SDEND) D:($Y+5)>IOSL HD Q:SDEND W !,?2,$P(^DPT(I3,0),"^",1),?34,$P(^(0),"^",9) S I4=0 F S I4=$O(^UTILITY($J,I,I2,I3,I4)) Q:I4="" D WRTC Q:SDEND
52 Q
53WRTC S SDY=$G(^UTILITY($J,I,I2,I3,I4)) I ($Y+4)>IOSL D HD Q:SDEND W !,?2,$P(^DPT(I3,0),"^",1),?34,$P(^(0),"^",9)," (CONTINUED)"
54 W !,?5,$P(^SC(+SDY,0),"^",1) S Y=I4,SD2=1 D AT^SDUTL W ?37,$J(Y,8) S SDB=50 F A=3:1:5 S Y="."_$P($P(SDY,"^",A),".",2) D AT^SDUTL W ?SDB,$J(Y,8) S SDB=SDB+10
55 ;comments/other
56 I $P($G(^UTILITY($J,I,I2,I3,I4)),"^",6)]"" W !,?15,$P(^(I4),"^",6) Q
57 Q
58HD I SD1,SDTT D OUT^SDUTL Q:SDEND
59 S SDPG=SDPG+1,SD1=1 W !,@IOF,!,?29,"INPATIENT APPOINTMENT LIST",?69,"PAGE: ",SDPG,! S SDOS=(77-$L(I))\2 W ?SDOS,"WARD: ",I S Y=DT D DTS^SDUTL W !,?31,"DATE PRINTED: ",Y,!!
60 W !!,"APPOINTMENT DATE",!,?2,"PATIENT NAME",?34,"SSN",!,?38,"APPOINT",?52,"LAB",?62,"XRAY",?72,"EKG",!,?5,"CLINIC",?38,"TIME" F A=52:10:72 W ?A,"TIME"
61 W !,?15,"OTHER INFORMATION",! F A=1:1:80 W "-"
62 S SD2=0 Q
63END S:'$D(IOF) IOF="#" W ! W:'SDTT @IOF K ^TMP($J,"SDAMA301"),^TMP($J,"SDAMA301C"),ALL,DIV,POP,SDT1,%DT,A,BEGDATE,DFN,DIC,DIV,ENDDATE,I,I1,I2,I3,I4,II,SD1,SDB,SDEND,SDOS,SDPG,SDSC,SDTT,SDW,SDXX,SDY,X,Y D CLOSE^DGUTQ,SDIAL^SDKILL Q
Note: See TracBrowser for help on using the repository browser.