Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m
r613 r623 1 SDAL ;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99 04:11PM ; Compiled August 20, 2007 14:24:592 ;;5.3;Scheduling;**37,46,106,171,177,80,266,491**;Aug 13, 1993;Build 533 EN 4 5 6 RD1 W ! N %DT K DIC("S") S %DT("A")="For date: ",%DT="AEX" D ^%DT7 8 9 10 11 12 13 N 14 15 16 17 18 19 20 21 22 START 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 LOOPA 54 55 56 57 OVER 58 59 END 60 61 62 63 EXIT 64 65 66 67 68 CLIN 69 70 71 72 73 BARQ(TTYPE,MARGIN) 74 75 76 77 78 79 BARCQ 80 81 QUE 82 83 84 85 86 87 88 89 STOP 90 91 92 HED 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 PAINT(CLINIC,DATE) 108 109 110 111 112 113 114 115 116 117 118 BARC(TAB,X) 119 120 121 122 123 124 1 SDAL ;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**37,46,106,171,177,80,266**;Aug 13, 1993 3 EN 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 6 RD1 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 13 N 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 ; 22 START 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 ;--------------------------------------------------------------------------- 53 LOOPA ;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 57 OVER ;S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT S VAUTC=0 G LOOPA 58 S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT G LOOPA 59 END 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 63 EXIT 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 ; 68 CLIN ;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 ; 73 BARQ(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="^" 79 BARCQ Q Y 80 ; 81 QUE ;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 ; 89 STOP ;Check for stop task request 90 S:$D(ZTQUEUED) (SDEND,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q 91 ; 92 HED ;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 ; 107 PAINT(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 ; 118 BARC(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 TracChangeset
for help on using the changeset viewer.
