SDAL ;ALB/GRR,MJK,SCM/GXT - APPOINTMENT LIST ;29 Jun 99 04:11PM ; Compiled JUNE 27, 2018 2:54 PM
;;5.3;Scheduling;**37,46,106,171,177,80,266,491,572,618,703**;Aug 13, 1993;Build 5
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
.... ;SD*618 Add patient's name to be one of the sort filter (Patient's Name~DFN)
.... S SDPNDFN=$P(^DPT(SDDFN,0),U,1)_"~"_SDDFN
.... M ^TMP($J,"SDAMA301","S",SDCL,SDDT,SDPNDFN)=^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
K SDCC,SDCONC,SDCP,SDD,SDEM1,SDDIF,SDDIF1,SDEA,SDEC,SDEDT
K SDEM,SDEND,SDFLG,SDFS,SDIN,SDNT,DTOUT,DUOUT,ZTQUEUED,ZTSTOP
K DIRUT,SDCOPY,SDPAGE,SDPCT,SDPNOW,SDPT0,SDOI,SDPD,SDREV
K SDT,SDX,SDXX,SDZ,VADAT,VADATE,VAUTC,VAUTNI,VAUTSTR,VAUTVB
K VAUTD,VAQK,X,Y,Y1,Y2,Z,SDCLAR,SDPNDFN,SDZDFN
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,!
;NSR# 20180330 - updated for SSN to be "Last 4 SSN" starting in column 41 versus column 44
W !," Appt.",?11,"Patient Name",?41,"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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAL 6788 printed Dec 13, 2024@02:47:02 Page 2
SDAL ;ALB/GRR,MJK,SCM/GXT - APPOINTMENT LIST ;29 Jun 99 04:11PM ; Compiled JUNE 27, 2018 2:54 PM
+1 ;;5.3;Scheduling;**37,46,106,171,177,80,266,491,572,618,703**;Aug 13, 1993;Build 5
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 ;SD*618 Add patient's name to be one of the sort filter (Patient's Name~DFN)
+29 SET SDPNDFN=$PIECE(^DPT(SDDFN,0),U,1)_"~"_SDDFN
+30 MERGE ^TMP($JOB,"SDAMA301","S",SDCL,SDDT,SDPNDFN)=^TMP($JOB,"SDAMA301",SDCL,SDDFN,SDDT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;---------------------------------------------------------------------------
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
+1 KILL SDCC,SDCONC,SDCP,SDD,SDEM1,SDDIF,SDDIF1,SDEA,SDEC,SDEDT
+2 KILL SDEM,SDEND,SDFLG,SDFS,SDIN,SDNT,DTOUT,DUOUT,ZTQUEUED,ZTSTOP
+3 KILL DIRUT,SDCOPY,SDPAGE,SDPCT,SDPNOW,SDPT0,SDOI,SDPD,SDREV
+4 KILL SDT,SDX,SDXX,SDZ,VADAT,VADATE,VAUTC,VAUTNI,VAUTSTR,VAUTVB
+5 KILL VAUTD,VAQK,X,Y,Y1,Y2,Z,SDCLAR,SDPNDFN,SDZDFN
+6 KILL SDBC,SDBCON,SDBCOFF,SDASH,SDPCMM,^TMP($JOB,"SDAMA301")
+7 DO CLOSE^DGUTQ
QUIT
+8 ;
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 ;NSR# 20180330 - updated for SSN to be "Last 4 SSN" starting in column 41 versus column 44
+16 WRITE !," Appt.",?11,"Patient Name",?41,"SSN",?53,"Lab",?62,"X-Ray",?73,"EKG"
+17 WRITE !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed"
+18 WRITE !,SDASH
SET SDPAGE=SDPAGE+1
+19 if SDBC
DO PAINT(SC,SDD)
+20 QUIT
+21 ;
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 ;
