SDAL.m

SDAL ;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99  04:11PM  ; Compiled August 20, 2007 14:24:59

 ;;5.3;PIMS;**37,46,106,171,177,80,266,491,1015,1016**;JUN 30, 2012;Build 20

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)

 ;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 ;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!" 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,SDFLG,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 ;process each clinic IEN from VAUTC array

 S (SDFLG,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

 ;SD*572 added following naked reference logic

 I 'SC D

 .I VAUTC W "Appointments for ALL clinics for ",SDPD Q

 .S CT=0,SNAM=""

 .F  S SNAM=$O(VAUTC(SNAM)) Q:SNAM=""  S CT=CT+1,SC=$G(VAUTC(SNAM))

 .I CT=1 W "Appointments for ",$P(^SC(SC,0),U,1)," clinic on ",SDPD D INACT

 .I CT>1!(CT<1) W "Appointments for Selected clinics for ",SDPD

 .K CT,SNAM,SC

 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 !,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

 ;

INACT ;SD*572 if single clinic selected check if inactive on selected date

 I $D(^SC(SC,"I")) I SDD=$P($G(^("I")),U,1)!(SDD>$P($G(^("I")),U,1)),'$P($G(^("I")),U,2) S SDPCT="Clinic Inactive on this date!" Q

 I $D(^SC(SC,"I")) I SDD=$P($G(^("I")),U,1)!(SDD>$P($G(^("I")),U,1))&(SDD<$P($G(^("I")),U,2)) S SDPCT="Clinic Inactive on this date!" Q

 S SDPCT="No Clinic Availability on this date!"

 Q

 ;

SDAL      ;ALB/GRR,MJK - APPOINTMENT LIST ; 29 Jun 99  04:11PM  ; Compiled August 20, 2007 14:24:59

 +1       ;;5.3;PIMS;**37,46,106,171,177,80,266,491,1015,1016**;JUN 30, 2012;Build 20

EN         WRITE !

           SET SDEND=1

           DO ASK2^SDDIV

           IF Y<0

               GOTO END

 +1        WRITE !

           SET VAUTNI=1

           DO NCOUNT^SDAL0

           IF SDCONC=U

               GOTO END

 +2        WRITE !

           DO NCLINIC^SDAL0

           IF Y<0

               GOTO END

RD1        WRITE !

           NEW %DT

           KILL DIC("S")

           SET %DT("A")="For date: "

           SET %DT="AEX"

           DO ^%DT

 +1        IF (X["^")!(Y<0)

               KILL %,VAUTD,VAUTC,X,Y

               QUIT 

 +2        SET SDD=Y

 +3        NEW DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +4        SET DIR("A")="Include Primary Care assignment information in the output"

 +5        WRITE !

           DO ^DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               KILL SDD,VAUTC,VAUTD,X,Y

               QUIT 

 +6        WRITE !

           SET SDPCMM=Y

N          KILL SDX,SDX1

           READ !,"Number of copies: 1// ",M:DTIME

           IF M=""

               SET M=1

 +1        IF M["^"

               KILL M,SDD,VAUTC,VAUTD,X,Y

               QUIT 

 +2        IF (M'?.N)!((M'>0)!($LENGTH(M)>3))

               WRITE !,"ENTER A WHOLE NUMBER TO SELECT THE # OF COPIES OF THE APPOINTMENT LIST THAT ARE NEEDED- (1-999)"

               GOTO N

 +3        SET SDCOPY=M

 +4       ; -- specify device

 +5        WRITE !

           NEW %ZIS

           KILL IO("Q")

           SET %ZIS="QMP"

           DO ^%ZIS

           IF POP

               GOTO END

 +6        SET SDBC=$$BARQ(+IOST(0),IOM)

           IF SDBC="^"

               GOTO END

 +7        IF $DATA(IO("Q"))

               DO QUE

               IF $DATA(ZTSK)

                   WRITE "   (Task#: ",ZTSK,")"

               GOTO END

 +8       ;

START      USE IO

           NEW CNT,SDCLAR,SDCOUNT

           SET (SDCOUNT,CNT)=0

 +1       ;SET UP A TEMP ARRAY -SDCLAR- WITH CLASSIFICATION ABBREVIATIONS

 +2        FOR 

               SET CNT=$ORDER(^SD(409.41,CNT))

               IF CNT'>0

                   QUIT 

               Begin DoDot:1

 +3                SET SDCLAR(CNT)=$PIECE(^SD(409.41,CNT,0),U,7)

               End DoDot:1

 +4        IF '$DATA(DTIME)

               SET DTIME=300

           IF '$DATA(DT)

               DO DT^SDUTL

 +5        SET SDASH=""

           SET $PIECE(SDASH,"_",IOM+1)=""

           SET SDBC=+$GET(SDBC)

           SET SDCOPY=$SELECT($DATA(SDCOPY):+SDCOPY,$DATA(M):+M,1:1)

 +6        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           SET SDPNOW=$PIECE(Y,":",1,2)

 +7        IF SDBC

               SET SDBC=$SELECT(IOM<120:0,1:$$BARC^SDAMU(+IOST(0),.SDBCON,.SDBCOFF))

 +8        SET (SDEND,SD1,PCNT)=0

           SET Y=DT

           DO D^DIQ

           SET SDNT=Y

           SET Y=SDD

           SET X=Y

           DO D^DIQ

           SET SDPD=Y

           DO DW^%DTC

           SET SDPD=X_" "_SDPD

 +9       ;if user has selected 'all' clinics, populate VAUTC with all uncancelled TYPE=C clinics from ^SC

 +10       IF VAUTC=1

               SET SDIEN=0

               FOR 

                   SET SDIEN=$ORDER(^SC(SDIEN))

                   IF +SDIEN=0

                       QUIT 

                   Begin DoDot:1

 +11                   IF $PIECE(^SC(SDIEN,0),"^",3)="C"

                           IF $GET(^SC(SDIEN,"ST",SDD,1))'["CANCELLED"

                               Begin DoDot:2

 +12                               SET SDNAME=$PIECE(^SC(SDIEN,0),"^",1)

                                   IF $GET(SDNAME)]""

                                       SET VAUTC(SDNAME)=SDIEN

                               End DoDot:2

                   End DoDot:1

 +13      ;-------------CALL TO SDAPI^SDAMA301 TO RETRIEVE APPT DATA------------------

 +14       KILL ^TMP($JOB,"SDAMA301")

           NEW SDARRAY,SDIEN,SDNAME,SDERR,SDCL,SDDFN,SDDT,SDRESULT

 +15       SET SDARRAY(1)=SDD_";"_SDD

           SET SDARRAY(3)="I;R;NT"

           SET SDARRAY("FLDS")="4;6;7;8;10;19;20;21"

 +16      ;if user has selected clinics, build clinic filter list

 +17      ;remove last ';' from end

           IF VAUTC'=1

               Begin DoDot:1

 +18               SET SD=""

                   FOR 

                       SET SD=$ORDER(VAUTC(SD))

                       IF SD']""

                           QUIT 

                       SET SC=$GET(VAUTC(SD))

                       IF $GET(SC)]""

                           SET SDARRAY(2)=$GET(SDARRAY(2))_SC_";"

               End DoDot:1

               IF $LENGTH(SDARRAY(2))

                   SET SDARRAY(2)=$EXTRACT(SDARRAY(2),1,$LENGTH(SDARRAY(2))-1)

 +19      ;call SDAPI to retrieve appointment data

 +20       SET SDRESULT=$$SDAPI^SDAMA301(.SDARRAY)

 +21      ;if error returned from SDAPI, display on report and quit

 +22       IF SDRESULT<0

               SET SDERR=$$SDAPIERR^SDAMUTDT()

               IF $LENGTH(SDERR)

                   SET SC=0

                   SET SDPAGE=1

                   DO HED

                   WRITE !!,SDERR,!

                   IF $EXTRACT(IOST,1,2)="C-"

                       DO OUT^SDUTL

                   DO EXIT

                   QUIT 

 +23      ;if appts returned from SDAPI, sort output by clinic, appt d/t, patient

 +24       IF SDRESULT>0

               Begin DoDot:1

 +25               SET SDCL=0

                   FOR 

                       SET SDCL=$ORDER(^TMP($JOB,"SDAMA301",SDCL))

                       IF 'SDCL

                           QUIT 

                       Begin DoDot:2

 +26                       SET SDDFN=0

                           FOR 

                               SET SDDFN=$ORDER(^TMP($JOB,"SDAMA301",SDCL,SDDFN))

                               IF 'SDDFN

                                   QUIT 

                               Begin DoDot:3

 +27                               SET SDDT=0

                                   FOR 

                                       SET SDDT=$ORDER(^TMP($JOB,"SDAMA301",SDCL,SDDFN,SDDT))

                                       IF 'SDDT

                                           QUIT 

                                       Begin DoDot:4

 +28                                       MERGE ^TMP($JOB,"SDAMA301","S",SDCL,SDDT,SDDFN)=^TMP($JOB,"SDAMA301",SDCL,SDDFN,SDDT)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +29      ;---------------------------------------------------------------------------

LOOPA     ;if no error returned from SDAPI, start looping through clinics in VAUTC (sorted by name)

 +1        IF SDRESULT'<0

               SET SD=0

               FOR 

                   SET SD=$ORDER(VAUTC(SD))

                   IF SD']""!SDEND

                       QUIT 

                   DO CLIN

 +2        IF SDEND

               GOTO END

OVER      ;S PCNT=PCNT+1 I PCNT<SDCOPY,SDCOUNT S VAUTC=0 G LOOPA

 +1        SET PCNT=PCNT+1

           IF PCNT<SDCOPY

               IF SDCOUNT

                   GOTO LOOPA

END        IF $GET(SDCOUNT)=""

               GOTO EXIT

 +1        IF SDCOUNT=0

               SET SDPCT="No activity found for this date!"

               SET SDPAGE=1

               SET SC=0

               DO HED

               WRITE !!?$LENGTH(SDPCT)\2,SDPCT,!

 +2        IF $EXTRACT(IOST,1,2)="C-"

               IF '$GET(SDEND)&$GET(SDCOUNT)

                   DO OUT^SDUTL

               WRITE @IOF

EXIT       KILL %,%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,SDFLG,SDFS,SDIN,SDNT

 +1        KILL 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

 +2        KILL SDBC,SDBCON,SDBCOFF,SDASH,SDPCMM,^TMP($JOB,"SDAMA301")

 +3        DO CLOSE^DGUTQ

           QUIT 

 +4       ;

CLIN      ;process each clinic IEN from VAUTC array

 +1        SET (SDFLG,SC)=0

           SET SC=$GET(VAUTC(SD))

           IF $GET(SC)>0

               IF $DATA(^SC(SC,0))

                   DO LOOP^SDAL0

 +2        QUIT 

 +3       ;

BARQ(TTYPE,MARGIN) ;

 +1        NEW ON,OFF,Y

 +2        IF MARGIN<120

               SET Y=0

               GOTO BARCQ

 +3        IF '$$BARC^SDAMU(.TTYPE,.ON,.OFF)

               SET Y=0

               GOTO BARCQ

 +4        SET DIR(0)="Y"

           SET DIR("B")="NO"

           SET DIR("A")="SHOULD BARCODES BE PRINTED ON LIST(S)"

 +5        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET Y="^"

BARCQ      QUIT Y

 +1       ;

QUE       ;Queue output

 +1        NEW ZTDESC,ZTSAVE,ZTRTN

 +2        KILL ZTSK,IO("Q")

 +3        SET ZTDESC="Appointment Lists"

           SET ZTRTN="START^SDAL"

 +4        FOR X="VAUTD(","VAUTC(","SDCOPY","SDD","SDBC","VAUTD","VAUTC","SDCONC","SDPCMM"

               SET ZTSAVE(X)=""

 +5        DO ^%ZTLOAD

 +6        QUIT 

 +7       ;

STOP      ;Check for stop task request

 +1        IF $DATA(ZTQUEUED)

               SET (SDEND,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)

           QUIT 

 +2       ;

HED       ;Print report header

 +1        IF SD1

               IF $EXTRACT(IOST)="C"

                   DO OUT^SDUTL

                   IF SDEND

                       QUIT 

 +2        DO STOP

           IF SDEND

               QUIT 

 +3        SET SDCOUNT=SDCOUNT+1

           SET SD1=1

 +4        IF SDCOUNT>1!($EXTRACT(IOST)="C")

               WRITE $$XY^SCRPW50(IOF,1,0)

           IF $X

               WRITE $$XY^SCRPW50("",0,0)

 +5        IF SC

               WRITE "Appointments for ",$PIECE(^SC(SC,0),"^",1)," clinic on ",SDPD

 +6       ;SD*572 added following naked reference logic

 +7        IF 'SC

               Begin DoDot:1

 +8                IF VAUTC

                       WRITE "Appointments for ALL clinics for ",SDPD

                       QUIT 

 +9                SET CT=0

                   SET SNAM=""

 +10               FOR 

                       SET SNAM=$ORDER(VAUTC(SNAM))

                       IF SNAM=""

                           QUIT 

                       SET CT=CT+1

                       SET SC=$GET(VAUTC(SNAM))

 +11               IF CT=1

                       WRITE "Appointments for ",$PIECE(^SC(SC,0),U,1)," clinic on ",SDPD

                       DO INACT

 +12               IF CT>1!(CT<1)

                       WRITE "Appointments for Selected clinics for ",SDPD

 +13               KILL CT,SNAM,SC

               End DoDot:1

 +14       WRITE !,"Date printed: ",SDPNOW,?(IOM-6-$LENGTH(SDPAGE)),"Page: ",SDPAGE,!

 +15       WRITE !," Appt.",?11,"Patient Name",?44,"SSN",?53,"Lab",?62,"X-Ray",?73,"EKG"

 +16       WRITE !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"

 +17       WRITE !,SDASH

           SET SDPAGE=SDPAGE+1

 +18       IF SDBC

               DO PAINT(SC,SDD)

 +19       QUIT 

 +20      ;

PAINT(CLINIC,DATE) ; -- paint header barcodes

 +1       ; input:  CLINIC := clinic ifn

 +2       ;           DATE := appt date only

 +3       ;

 +4        WRITE !?10,"Date",?45,"Clinic#",?85,"No",?110,"Yes",!

 +5        DO BARC(10,$EXTRACT(DATE,4,7)_$EXTRACT(DATE,2,3))

 +6        DO BARC(45,"%"_CLINIC_"$")

 +7        DO BARC(85,"N")

           DO BARC(110,"Y")

 +8        WRITE !!!!,SDASH

 +9        QUIT 

 +10      ;

BARC(TAB,X) ; --print barcode

 +1       ; input: TAB := tab position

 +2       ;          X := string to print

 +3       ;

 +4        WRITE *13,?TAB

           WRITE @SDBCON,X,@SDBCOFF

 +5        QUIT 

 +6       ;

INACT     ;SD*572 if single clinic selected check if inactive on selected date

 +1        IF $DATA(^SC(SC,"I"))

               IF SDD=$PIECE($GET(^("I")),U,1)!(SDD>$PIECE($GET(^("I")),U,1))

                   IF '$PIECE($GET(^("I")),U,2)

                       SET SDPCT="Clinic Inactive on this date!"

                       QUIT 

 +2        IF $DATA(^SC(SC,"I"))

               IF SDD=$PIECE($GET(^("I")),U,1)!(SDD>$PIECE($GET(^("I")),U,1))&(SDD<$PIECE($GET(^("I")),U,2))

                   SET SDPCT="Clinic Inactive on this date!"

                   QUIT 

 +3        SET SDPCT="No Clinic Availability on this date!"

 +4        QUIT 

 +5       ;