source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m@ 1147

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

revised back to 6/30/08 version

File size: 6.0 KB
Line 
1SDAL ;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99 04:11PM
2 ;;5.3;Scheduling;**37,46,106,171,177,80,266**;Aug 13, 1993
3EN W ! S SDEND=1 D ASK2^SDDIV G:Y<0 END
4 W ! S VAUTNI=1 D NCOUNT^SDAL0 I SDCONC=U G END
5 W ! D NCLINIC^SDAL0 G:Y<0 END
6RD1 W ! N %DT K DIC("S") S %DT("A")="For date: ",%DT="AEXF" D ^%DT
7 I (X["^")!(Y<0) K %,VAUTD,VAUTC,X,Y Q
8 S SDD=Y
9 N DIR S DIR(0)="Y",DIR("B")="NO"
10 S DIR("A")="Include Primary Care assignment information in the output"
11 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) K SDD,VAUTC,VAUTD,X,Y Q
12 W ! S SDPCMM=Y
13N K SDX,SDX1 R !,"Number of copies: 1// ",M:DTIME S:M="" M=1
14 I M["^" K M,SDD,VAUTC,VAUTD,X,Y Q
15 I (M'?.N)!((M'>0)!($L(M)>3)) W !,"ENTER A WHOLE NUMBER TO SELECT THE # OF COPIES OF THE APPOINTMENT LIST THAT ARE NEEDED- (1-999)" G N
16 S SDCOPY=M
17 ; -- specify device
18 W ! N %ZIS K IO("Q") S %ZIS="QMP" D ^%ZIS G END:POP
19 S SDBC=$$BARQ(+IOST(0),IOM) I SDBC="^" G END
20 I $D(IO("Q")) D QUE W:$D(ZTSK) " (Task#: ",ZTSK,")" G END
21 ;
22START U IO N CNT,SDCLAR,SDCOUNT S (SDCOUNT,CNT)=0
23 ;SET UP A TEMP ARRAY -SDCLAR- WITH CLASSIFICATION ABBREVIATIONS
24 F S CNT=$O(^SD(409.41,CNT)) Q:CNT'>0 D
25 .S SDCLAR(CNT)=$P(^SD(409.41,CNT,0),U,7)
26 S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
27 S SDASH="",$P(SDASH,"_",IOM+1)="" S SDBC=+$G(SDBC),SDCOPY=$S($D(SDCOPY):+SDCOPY,$D(M):+M,1:1)
28 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2)
29 I SDBC S SDBC=$S(IOM<120:0,1:$$BARC^SDAMU(+IOST(0),.SDBCON,.SDBCOFF))
30 S (SDEND,SD1,PCNT)=0,Y=DT D D^DIQ S SDNT=Y,Y=SDD,X=Y D D^DIQ S SDPD=Y D DW^%DTC S SDPD=X_" "_SDPD
31 ;if user has selected 'all' clinics, populate VAUTC with all uncancelled TYPE=C clinics from ^SC
32 I VAUTC=1 S SDIEN=0 F S SDIEN=$O(^SC(SDIEN)) Q:+SDIEN=0 D
33 . I $P(^SC(SDIEN,0),"^",3)="C",$G(^SC(SDIEN,"ST",SDD,1))'["CANCELLED" D
34 .. S SDNAME=$P(^SC(SDIEN,0),"^",1) I $G(SDNAME)]"" S VAUTC(SDNAME)=SDIEN
35 ;-------------CALL TO SDAPI^SDAMA301 TO RETRIEVE APPT DATA------------------
36 K ^TMP($J,"SDAMA301") N SDARRAY,SDIEN,SDNAME,SDERR,SDCL,SDDFN,SDDT,SDRESULT
37 S SDARRAY(1)=SDD_";"_SDD,SDARRAY(3)="I;R;NT",SDARRAY("FLDS")="4;6;7;8;10;19;20;21"
38 ;if user has selected clinics, build clinic filter list
39 I VAUTC'=1 D I $L(SDARRAY(2)) S SDARRAY(2)=$E(SDARRAY(2),1,$L(SDARRAY(2))-1) ;remove last ';' from end
40 . S SD="" F S SD=$O(VAUTC(SD)) Q:SD']"" S SC=$G(VAUTC(SD)) I $G(SC)]"" S SDARRAY(2)=$G(SDARRAY(2))_SC_";"
41 ;call SDAPI to retrieve appointment data
42 S SDRESULT=$$SDAPI^SDAMA301(.SDARRAY)
43 ;I SDRESULT<0 S SDERR=$$SDAPIERR^SDAMUTDT() I $L(SDERR) S SC=0 D HED W !!,SDERR,! I $E(IOST,1,2)="C-" D OUT^SDUTL
44 ;if error returned from SDAPI, display on report and quit
45 I SDRESULT<0 S SDERR=$$SDAPIERR^SDAMUTDT() I $L(SDERR) S SC=0 S SDPAGE=1 D HED W !!,SDERR,! D:$E(IOST,1,2)="C-" OUT^SDUTL D EXIT Q
46 ;if appts returned from SDAPI, sort output by clinic, appt d/t, patient
47 I SDRESULT>0 D
48 . S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",SDCL)) Q:'SDCL D
49 .. S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDCL,SDDFN)) Q:'SDDFN D
50 ... S SDDT=0 F S SDDT=$O(^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)) Q:'SDDT D
51 .... M ^TMP($J,"SDAMA301","S",SDCL,SDDT,SDDFN)=^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)
52 ;---------------------------------------------------------------------------
53LOOPA ;S SD=0 F S SD=$S(VAUTC:$O(^SC("B",SD)),1:$O(VAUTC(SD))) Q:SD']""!SDEND D CLIN
54 ;if no error returned from SDAPI, start looping through clinics in VAUTC (sorted by name)
55 I SDRESULT'<0 S SD=0 F S SD=$O(VAUTC(SD)) Q:SD']""!SDEND D CLIN
56 G:SDEND END
57OVER ;S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT S VAUTC=0 G LOOPA
58 S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT G LOOPA
59END I $G(SDCOUNT)="" G EXIT
60 ;I SDCOUNT=0 S SDPCT="No activity found for this date!" D HED W !!?$L(SDPCT)\2,SDPCT,!
61 I SDCOUNT=0 S SDPCT="No activity found for this date!" S SDPAGE=1,SC=0 D HED W !!?$L(SDPCT)\2,SDPCT,!
62 I $E(IOST,1,2)="C-" D:'$G(SDEND)&$G(SDCOUNT) OUT^SDUTL W @IOF
63EXIT K %,%H,%H,A,ALL,DFN,DIC,I,INC,K,M,PCNT,POP,PT,SC,SD,SD1,SDCC,SDCONC,SDCP,SDD,SDEM1,SDDIF,SDDIF1,SDEA,SDEC,SDEDT,SDEM,SDEND,SDFL,SDFS,SDIN,SDNT
64 K DIRUT,SDCOPY,SDPAGE,SDPCT,SDPNOW,SDPT0,SDOI,SDPD,SDREV,SDT,SDX,SDXX,SDZ,VADAT,VADATE,VAUTC,VAUTNI,VAUTSTR,VAUTVB,VAUTD,VAQK,X,Y,Y1,Y2,Z
65 K SDBC,SDBCON,SDBCOFF,SDASH,SDPCMM,^TMP($J,"SDAMA301")
66 D CLOSE^DGUTQ Q
67 ;
68CLIN ;S (SDFL,SC)=0 F S SC=$O(^SC("B",SD,SC)) Q:SC'>0!SDEND I $D(^SC(SC,0)),$P(^(0),"^",3)="C" I $S(VAUTC:1,'$D(VAUTC(SD)):0,VAUTC(SD)=SC:1,1:0) D LOOP^SDAL0
69 ;process each clinic IEN from VAUTC array
70 S (SDFL,SC)=0 S SC=$G(VAUTC(SD)) I $G(SC)>0,$D(^SC(SC,0)) D LOOP^SDAL0
71 Q
72 ;
73BARQ(TTYPE,MARGIN) ;
74 N ON,OFF,Y
75 I MARGIN<120 S Y=0 G BARCQ
76 I '$$BARC^SDAMU(.TTYPE,.ON,.OFF) S Y=0 G BARCQ
77 S DIR(0)="Y",DIR("B")="NO",DIR("A")="SHOULD BARCODES BE PRINTED ON LIST(S)"
78 D ^DIR K DIR S:$D(DIRUT) Y="^"
79BARCQ Q Y
80 ;
81QUE ;Queue output
82 N ZTDESC,ZTSAVE,ZTRTN
83 K ZTSK,IO("Q")
84 S ZTDESC="Appointment Lists",ZTRTN="START^SDAL"
85 F X="VAUTD(","VAUTC(","SDCOPY","SDD","SDBC","VAUTD","VAUTC","SDCONC","SDPCMM" S ZTSAVE(X)=""
86 D ^%ZTLOAD
87 Q
88 ;
89STOP ;Check for stop task request
90 S:$D(ZTQUEUED) (SDEND,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
91 ;
92HED ;Print report header
93 I SD1,$E(IOST)="C" D OUT^SDUTL Q:SDEND
94 D STOP Q:SDEND
95 S SDCOUNT=SDCOUNT+1,SD1=1
96 W:SDCOUNT>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
97 W:SC "Appointments for ",$P(^SC(SC,0),"^",1)," clinic on ",SDPD
98 W:'SC "Appointments for ",SDPD
99 W !,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!
100 W !," Appt.",?11,"Patient Name",?44,"SSN",?53,"Lab",?62,"X-Ray",?73,"EKG"
101 ;W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
102 W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
103 W !,SDASH S SDPAGE=SDPAGE+1
104 D:SDBC PAINT(SC,SDD)
105 Q
106 ;
107PAINT(CLINIC,DATE) ; -- paint header barcodes
108 ; input: CLINIC := clinic ifn
109 ; DATE := appt date only
110 ;
111 W !?10,"Date",?45,"Clinic#",?85,"No",?110,"Yes",!
112 D BARC(10,$E(DATE,4,7)_$E(DATE,2,3))
113 D BARC(45,"%"_CLINIC_"$")
114 D BARC(85,"N"),BARC(110,"Y")
115 W !!!!,SDASH
116 Q
117 ;
118BARC(TAB,X) ; --print barcode
119 ; input: TAB := tab position
120 ; X := string to print
121 ;
122 W *13,?TAB W @SDBCON,X,@SDBCOFF
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.