Index: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m
===================================================================
--- WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m	(revision 613)
+++ WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDAL.m	(revision 623)
@@ -1,124 +1,124 @@
-SDAL	;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99  04:11PM  ; Compiled August 20, 2007 14:24:59
-	;;5.3;Scheduling;**37,46,106,171,177,80,266,491**;Aug 13, 1993;Build 53
-EN	W ! S SDEND=1 D ASK2^SDDIV G:Y<0 END
-	W ! S VAUTNI=1 D NCOUNT^SDAL0 I SDCONC=U G END
-	W ! D NCLINIC^SDAL0 G:Y<0 END
-RD1	W ! N %DT K DIC("S") S %DT("A")="For date: ",%DT="AEX" D ^%DT
-	I (X["^")!(Y<0) K %,VAUTD,VAUTC,X,Y Q
-	S SDD=Y
-	N DIR S DIR(0)="Y",DIR("B")="NO"
-	S DIR("A")="Include Primary Care assignment information in the output"
-	W ! D ^DIR I $D(DTOUT)!$D(DUOUT) K SDD,VAUTC,VAUTD,X,Y Q
-	W ! S SDPCMM=Y
-N	K SDX,SDX1 R !,"Number of copies: 1// ",M:DTIME S:M="" M=1
-	I M["^" K M,SDD,VAUTC,VAUTD,X,Y Q
-	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
-	S SDCOPY=M
-	; -- specify device
-	W ! N %ZIS K IO("Q") S %ZIS="QMP" D ^%ZIS G END:POP
-	S SDBC=$$BARQ(+IOST(0),IOM) I SDBC="^" G END
-	I $D(IO("Q")) D QUE W:$D(ZTSK) "   (Task#: ",ZTSK,")" G END
-	;
-START	U IO N CNT,SDCLAR,SDCOUNT S (SDCOUNT,CNT)=0
-	;SET UP A TEMP ARRAY -SDCLAR- WITH CLASSIFICATION ABBREVIATIONS
-	F  S CNT=$O(^SD(409.41,CNT)) Q:CNT'>0  D
-	.S SDCLAR(CNT)=$P(^SD(409.41,CNT,0),U,7)
-	S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
-	S SDASH="",$P(SDASH,"_",IOM+1)="" S SDBC=+$G(SDBC),SDCOPY=$S($D(SDCOPY):+SDCOPY,$D(M):+M,1:1)
-	D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2)
-	I SDBC S SDBC=$S(IOM<120:0,1:$$BARC^SDAMU(+IOST(0),.SDBCON,.SDBCOFF))
-	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
-	;if user has selected 'all' clinics, populate VAUTC with all uncancelled TYPE=C clinics from ^SC
-	I VAUTC=1 S SDIEN=0 F  S SDIEN=$O(^SC(SDIEN)) Q:+SDIEN=0  D
-	. I $P(^SC(SDIEN,0),"^",3)="C",$G(^SC(SDIEN,"ST",SDD,1))'["CANCELLED" D
-	.. S SDNAME=$P(^SC(SDIEN,0),"^",1) I $G(SDNAME)]"" S VAUTC(SDNAME)=SDIEN
-	;-------------CALL TO SDAPI^SDAMA301 TO RETRIEVE APPT DATA------------------
-	K ^TMP($J,"SDAMA301") N SDARRAY,SDIEN,SDNAME,SDERR,SDCL,SDDFN,SDDT,SDRESULT
-	S SDARRAY(1)=SDD_";"_SDD,SDARRAY(3)="I;R;NT",SDARRAY("FLDS")="4;6;7;8;10;19;20;21"
-	;if user has selected clinics, build clinic filter list
-	I VAUTC'=1 D  I $L(SDARRAY(2)) S SDARRAY(2)=$E(SDARRAY(2),1,$L(SDARRAY(2))-1) ;remove last ';' from end
-	. 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_";"
-	;call SDAPI to retrieve appointment data
-	S SDRESULT=$$SDAPI^SDAMA301(.SDARRAY)
-	;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
-	;if error returned from SDAPI, display on report and quit
-	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
-	;if appts returned from SDAPI, sort output by clinic, appt d/t, patient
-	I SDRESULT>0 D
-	. S SDCL=0 F  S SDCL=$O(^TMP($J,"SDAMA301",SDCL)) Q:'SDCL  D
-	.. S SDDFN=0 F  S SDDFN=$O(^TMP($J,"SDAMA301",SDCL,SDDFN)) Q:'SDDFN  D
-	... S SDDT=0 F  S SDDT=$O(^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)) Q:'SDDT  D
-	.... M ^TMP($J,"SDAMA301","S",SDCL,SDDT,SDDFN)=^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)
-	;---------------------------------------------------------------------------
-LOOPA	;S SD=0 F  S SD=$S(VAUTC:$O(^SC("B",SD)),1:$O(VAUTC(SD))) Q:SD']""!SDEND  D CLIN
-	;if no error returned from SDAPI, start looping through clinics in VAUTC (sorted by name)
-	I SDRESULT'<0 S SD=0 F  S SD=$O(VAUTC(SD)) Q:SD']""!SDEND  D CLIN
-	G:SDEND END
-OVER	;S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT S VAUTC=0 G LOOPA
-	S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT G LOOPA
-END	I $G(SDCOUNT)="" G EXIT
-	;I SDCOUNT=0 S SDPCT="No activity found for this date!" D HED W !!?$L(SDPCT)\2,SDPCT,!
-	I SDCOUNT=0 S SDPCT="No activity found for this date!" S SDPAGE=1,SC=0 D HED W !!?$L(SDPCT)\2,SDPCT,!
-	I $E(IOST,1,2)="C-" D:'$G(SDEND)&$G(SDCOUNT) OUT^SDUTL W @IOF
-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
-	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
-	K SDBC,SDBCON,SDBCOFF,SDASH,SDPCMM,^TMP($J,"SDAMA301")
-	D CLOSE^DGUTQ Q
-	;
-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
-	;process each clinic IEN from VAUTC array
-	S (SDFL,SC)=0 S SC=$G(VAUTC(SD)) I $G(SC)>0,$D(^SC(SC,0)) D LOOP^SDAL0
-	Q
-	;
-BARQ(TTYPE,MARGIN)	;
-	N ON,OFF,Y
-	I MARGIN<120 S Y=0 G BARCQ
-	I '$$BARC^SDAMU(.TTYPE,.ON,.OFF) S Y=0 G BARCQ
-	S DIR(0)="Y",DIR("B")="NO",DIR("A")="SHOULD BARCODES BE PRINTED ON LIST(S)"
-	D ^DIR K DIR S:$D(DIRUT) Y="^"
-BARCQ	Q Y
-	;
-QUE	;Queue output
-	N ZTDESC,ZTSAVE,ZTRTN
-	K ZTSK,IO("Q")
-	S ZTDESC="Appointment Lists",ZTRTN="START^SDAL"
-	F X="VAUTD(","VAUTC(","SDCOPY","SDD","SDBC","VAUTD","VAUTC","SDCONC","SDPCMM" S ZTSAVE(X)=""
-	D ^%ZTLOAD
-	Q
-	;
-STOP	;Check for stop task request
-	S:$D(ZTQUEUED) (SDEND,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
-	;
-HED	;Print report header
-	I SD1,$E(IOST)="C" D OUT^SDUTL Q:SDEND
-	D STOP Q:SDEND
-	S SDCOUNT=SDCOUNT+1,SD1=1
-	W:SDCOUNT>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
-	W:SC "Appointments for ",$P(^SC(SC,0),"^",1)," clinic on ",SDPD
-	W:'SC "Appointments for ",SDPD
-	W !,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!
-	W !," Appt.",?11,"Patient Name",?44,"SSN",?53,"Lab",?62,"X-Ray",?73,"EKG"
-	;W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
-	W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
-	W !,SDASH S SDPAGE=SDPAGE+1
-	D:SDBC PAINT(SC,SDD)
-	Q
-	;
-PAINT(CLINIC,DATE)	; -- paint header barcodes
-	; input:  CLINIC := clinic ifn
-	;           DATE := appt date only
-	;
-	W !?10,"Date",?45,"Clinic#",?85,"No",?110,"Yes",!
-	D BARC(10,$E(DATE,4,7)_$E(DATE,2,3))
-	D BARC(45,"%"_CLINIC_"$")
-	D BARC(85,"N"),BARC(110,"Y")
-	W !!!!,SDASH
-	Q
-	;
-BARC(TAB,X)	; --print barcode
-	; input: TAB := tab position
-	;          X := string to print
-	;
-	W *13,?TAB W @SDBCON,X,@SDBCOFF
-	Q
-	;
+SDAL ;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99  04:11PM
+ ;;5.3;Scheduling;**37,46,106,171,177,80,266**;Aug 13, 1993
+EN W ! S SDEND=1 D ASK2^SDDIV G:Y<0 END
+ W ! S VAUTNI=1 D NCOUNT^SDAL0 I SDCONC=U G END
+ W ! D NCLINIC^SDAL0 G:Y<0 END
+RD1 W ! N %DT K DIC("S") S %DT("A")="For date: ",%DT="AEXF" D ^%DT
+ I (X["^")!(Y<0) K %,VAUTD,VAUTC,X,Y Q
+ S SDD=Y
+ N DIR S DIR(0)="Y",DIR("B")="NO"
+ S DIR("A")="Include Primary Care assignment information in the output"
+ W ! D ^DIR I $D(DTOUT)!$D(DUOUT) K SDD,VAUTC,VAUTD,X,Y Q
+ W ! S SDPCMM=Y
+N K SDX,SDX1 R !,"Number of copies: 1// ",M:DTIME S:M="" M=1
+ I M["^" K M,SDD,VAUTC,VAUTD,X,Y Q
+ 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
+ S SDCOPY=M
+ ; -- specify device
+ W ! N %ZIS K IO("Q") S %ZIS="QMP" D ^%ZIS G END:POP
+ S SDBC=$$BARQ(+IOST(0),IOM) I SDBC="^" G END
+ I $D(IO("Q")) D QUE W:$D(ZTSK) "   (Task#: ",ZTSK,")" G END
+ ;
+START U IO N CNT,SDCLAR,SDCOUNT S (SDCOUNT,CNT)=0
+ ;SET UP A TEMP ARRAY -SDCLAR- WITH CLASSIFICATION ABBREVIATIONS
+ F  S CNT=$O(^SD(409.41,CNT)) Q:CNT'>0  D
+ .S SDCLAR(CNT)=$P(^SD(409.41,CNT,0),U,7)
+ S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
+ S SDASH="",$P(SDASH,"_",IOM+1)="" S SDBC=+$G(SDBC),SDCOPY=$S($D(SDCOPY):+SDCOPY,$D(M):+M,1:1)
+ D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2)
+ I SDBC S SDBC=$S(IOM<120:0,1:$$BARC^SDAMU(+IOST(0),.SDBCON,.SDBCOFF))
+ 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
+ ;if user has selected 'all' clinics, populate VAUTC with all uncancelled TYPE=C clinics from ^SC
+ I VAUTC=1 S SDIEN=0 F  S SDIEN=$O(^SC(SDIEN)) Q:+SDIEN=0  D
+ . I $P(^SC(SDIEN,0),"^",3)="C",$G(^SC(SDIEN,"ST",SDD,1))'["CANCELLED" D
+ .. S SDNAME=$P(^SC(SDIEN,0),"^",1) I $G(SDNAME)]"" S VAUTC(SDNAME)=SDIEN
+ ;-------------CALL TO SDAPI^SDAMA301 TO RETRIEVE APPT DATA------------------
+ K ^TMP($J,"SDAMA301") N SDARRAY,SDIEN,SDNAME,SDERR,SDCL,SDDFN,SDDT,SDRESULT
+ S SDARRAY(1)=SDD_";"_SDD,SDARRAY(3)="I;R;NT",SDARRAY("FLDS")="4;6;7;8;10;19;20;21"
+ ;if user has selected clinics, build clinic filter list
+ I VAUTC'=1 D  I $L(SDARRAY(2)) S SDARRAY(2)=$E(SDARRAY(2),1,$L(SDARRAY(2))-1) ;remove last ';' from end
+ . 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_";"
+ ;call SDAPI to retrieve appointment data
+ S SDRESULT=$$SDAPI^SDAMA301(.SDARRAY)
+ ;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
+ ;if error returned from SDAPI, display on report and quit
+ 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
+ ;if appts returned from SDAPI, sort output by clinic, appt d/t, patient
+ I SDRESULT>0 D
+ . S SDCL=0 F  S SDCL=$O(^TMP($J,"SDAMA301",SDCL)) Q:'SDCL  D
+ .. S SDDFN=0 F  S SDDFN=$O(^TMP($J,"SDAMA301",SDCL,SDDFN)) Q:'SDDFN  D
+ ... S SDDT=0 F  S SDDT=$O(^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)) Q:'SDDT  D
+ .... M ^TMP($J,"SDAMA301","S",SDCL,SDDT,SDDFN)=^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)
+ ;---------------------------------------------------------------------------
+LOOPA ;S SD=0 F  S SD=$S(VAUTC:$O(^SC("B",SD)),1:$O(VAUTC(SD))) Q:SD']""!SDEND  D CLIN
+ ;if no error returned from SDAPI, start looping through clinics in VAUTC (sorted by name)
+ I SDRESULT'<0 S SD=0 F  S SD=$O(VAUTC(SD)) Q:SD']""!SDEND  D CLIN
+ G:SDEND END
+OVER ;S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT S VAUTC=0 G LOOPA
+ S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT G LOOPA
+END I $G(SDCOUNT)="" G EXIT
+ ;I SDCOUNT=0 S SDPCT="No activity found for this date!" D HED W !!?$L(SDPCT)\2,SDPCT,!
+ I SDCOUNT=0 S SDPCT="No activity found for this date!" S SDPAGE=1,SC=0 D HED W !!?$L(SDPCT)\2,SDPCT,!
+ I $E(IOST,1,2)="C-" D:'$G(SDEND)&$G(SDCOUNT) OUT^SDUTL W @IOF
+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
+ 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
+ K SDBC,SDBCON,SDBCOFF,SDASH,SDPCMM,^TMP($J,"SDAMA301")
+ D CLOSE^DGUTQ Q
+ ;
+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
+ ;process each clinic IEN from VAUTC array
+ S (SDFL,SC)=0 S SC=$G(VAUTC(SD)) I $G(SC)>0,$D(^SC(SC,0)) D LOOP^SDAL0
+ Q
+ ;
+BARQ(TTYPE,MARGIN) ;
+ N ON,OFF,Y
+ I MARGIN<120 S Y=0 G BARCQ
+ I '$$BARC^SDAMU(.TTYPE,.ON,.OFF) S Y=0 G BARCQ
+ S DIR(0)="Y",DIR("B")="NO",DIR("A")="SHOULD BARCODES BE PRINTED ON LIST(S)"
+ D ^DIR K DIR S:$D(DIRUT) Y="^"
+BARCQ Q Y
+ ;
+QUE ;Queue output
+ N ZTDESC,ZTSAVE,ZTRTN
+ K ZTSK,IO("Q")
+ S ZTDESC="Appointment Lists",ZTRTN="START^SDAL"
+ F X="VAUTD(","VAUTC(","SDCOPY","SDD","SDBC","VAUTD","VAUTC","SDCONC","SDPCMM" S ZTSAVE(X)=""
+ D ^%ZTLOAD
+ Q
+ ;
+STOP ;Check for stop task request
+ S:$D(ZTQUEUED) (SDEND,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
+ ;
+HED ;Print report header
+ I SD1,$E(IOST)="C" D OUT^SDUTL Q:SDEND
+ D STOP Q:SDEND
+ S SDCOUNT=SDCOUNT+1,SD1=1
+ W:SDCOUNT>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
+ W:SC "Appointments for ",$P(^SC(SC,0),"^",1)," clinic on ",SDPD
+ W:'SC "Appointments for ",SDPD
+ W !,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!
+ W !," Appt.",?11,"Patient Name",?44,"SSN",?53,"Lab",?62,"X-Ray",?73,"EKG"
+ ;W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
+ W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
+ W !,SDASH S SDPAGE=SDPAGE+1
+ D:SDBC PAINT(SC,SDD)
+ Q
+ ;
+PAINT(CLINIC,DATE) ; -- paint header barcodes
+ ; input:  CLINIC := clinic ifn
+ ;           DATE := appt date only
+ ;
+ W !?10,"Date",?45,"Clinic#",?85,"No",?110,"Yes",!
+ D BARC(10,$E(DATE,4,7)_$E(DATE,2,3))
+ D BARC(45,"%"_CLINIC_"$")
+ D BARC(85,"N"),BARC(110,"Y")
+ W !!!!,SDASH
+ Q
+ ;
+BARC(TAB,X) ; --print barcode
+ ; input: TAB := tab position
+ ;          X := string to print
+ ;
+ W *13,?TAB W @SDBCON,X,@SDBCOFF
+ Q
+ ;
