SDAL0 ;ALB/GRR,TMP,MJK - APPOINTMENT LIST (CONTINUED FROM SDAL) ; 29 Jun 99 04:11PM
;;5.3;PIMS;**28,37,106,149,171,177,193,305,373,266,1015,1016**;JUN 30, 2012;Build 20
LOOP I 'VAUTC,$G(^SC(SC,"ST",SDD,1))["CANCELLED" D Q
.S SDPAGE=1 D HED^SDAL
.S SDPCT="Clinic cancelled for this date!"
.W !!?(IOM-$L(SDPCT)\2),SDPCT
I $$CHECK(),$$NCHECK(),$$ACTIVE() D
.S SDPAGE=1 D HED^SDAL Q:SDEND S SDPCT=0,SDFLG=1 ;SD*572 set flag
.;loop through sorted appointment data for the clinic
.N SDT,SDDFN,SDDATA,SDDATAC S SDT="" F S SDT=$O(^TMP($J,"SDAMA301","S",SC,SDT)) Q:'SDT D
..S SDDFN="" F S SDDFN=$O(^TMP($J,"SDAMA301","S",SC,SDT,SDDFN)) Q:'SDDFN!SDEND D
...;store appt data and comments for later reference
...S SDDATA=$G(^TMP($J,"SDAMA301","S",SC,SDT,SDDFN)),SDDATAC=$G(^(SDDFN,"C"))
...D MORE
.W ! D CCLK Q:SDEND
.I 'SDPCT S SDPCT="No activity found for this clinic date!" W !!?(IOM-$L(SDPCT)\2),SDPCT
S SDPAGE=1 Q
;
PTL N SDAPPT
S DFN=+$P(SDDATA,"^",4),SDOI=$G(SDDATAC)
S SDAPPT=""
D ^VAUQWK,GETA
I ($Y+7>IOSL) D HED^SDAL Q:SDEND
I '$D(SDFS) S SDFS=1,X=PT D TM^SDROUT0 W !,$J(X,8)
N SDCLY D CL^SDCO21(DFN,SDT,"",.SDCLY)
N SDY S SDY=$Y
W ! D:SDBC BARC^SDAL(85,$P(VAQK(2),"^"))
;check for Combat Vet
N SDCV
S SDCV=$$CVEDT^DGCV(DFN,$G(SDD))
S SDCV=$P(SDCV,U,3)
W !?3,$S($G(SDCV)=1:"(CV)",1:""),?9,$S($P(SDDATA,"^",7)="Y":"*",1:""),?10,$S(VAQK(1)]"":VAQK(1),1:"UNKNOWN PATIENT"),?41,$S(VAQK(2)]"":$E(VAQK(2),1,9),1:"")
S INC=0 F SDZ=3,4,5 S X=SDZ(SDZ) D:X]"" TM^SDROUT0 S INC=SDZ#3*8+3 W ?48+INC,$J(X,8) W:INC<16 " "
I VAQK(12)]"" W !,?41,VAQK(12) W:VAQK(13)]"" !,?41,VAQK(13)
W:SDOI]"" !,?15,SDOI W:SDEM]"" !,?15,SDEM,$S($D(SDCP):$P(^SC(SDCP,0),"^"),1:$P(^SC(SC,0),"^")),!,?15,SDEM1
W !,?10,"Phone #: ",$P($G(^DPT(DFN,.13)),"^",1) ;Phone Number [Residence]
S SDX="" F I=7:1:9 I VAQK(I) S SDX=1 Q
;Primary Care information
I +$G(SDPCMM) D TDATA^SDPPTEM(DFN,"",SDD,"P",15)
;; GAF SCORE CHECK
N SDGAF,SDGAFST
;use Appt Type here since COLLATERAL VISIT field not supported by encapsulation API
I $$MHCLIN^SDUTL2(SC),'($$COLLAT^SDUTL2(+VAQK(6))!$P($P(SDDATA,"^",10),";",2)["COLLATERAL OF VET") D
. S SDGAF=$$NEWGAF^SDUTL2(DFN),SDGAFST=$P(SDGAF,"^")
. W:SDGAFST !,?15,"** New GAF Score Required **"
;;
I $O(SDCLY(0)) D
.N PCL
.S PCL=0
.W !,?15,"** Required for facility workload credit => "
.F S PCL=$O(SDCLY(PCL)) Q:'PCL D
.. W " ",SDCLAR(PCL)," "
.. I (SDCLAR(PCL)="SC")&($G(^DPT(DFN,0))]"") D
... K SDELAR
... S VAROOT="SDELAR"
... D ELIG^VADPT
... Q:'$P($G(SDELAR(3)),"^")
... W $P(SDELAR(3),"^",2),"% "
... K SDELAR,VAROOT
.W "**"
I $P(VAQK(11),"^",2)]"" W !,?15,"Means Test: ** ",$P(VAQK(11),"^",2)," **" W " Last Test: ",$$FDATE^SDUL1($P($$LST^DGMTU(DFN),U,2))
S SDCOPS=$$LST^DGMTU(DFN,DT,2) I +SDCOPS W !,?15,"Co-Pay Status: ","**"_$P(SDCOPS,U,3)_"**"," Last Test: ",$$FDATE^SDUL1($P(SDCOPS,U,2)) K SDCOPS
I $D(^DIC(8,+VAQK(6),0)),$P(^(0),U,9)=13 W !,?15,"** COLLATERAL **" G Q
I +$P(SDDATA,"^",8)]"" D I V W !,?15,"** COLLATERAL **" G Q
.S V=+$P(SDDATA,"^",8),V=$S($D(^DIC(8,+V,0)):$P(^(0),"^",9)=13,1:0)
;use Appt Type here since COLLATERAL VISIT field not supported by encapsulation API
I $P($P(SDDATA,"^",10),";",2)["COLLATERAL OF VET" W !,?15,"** COLLATERAL VISIT **"
I +$P($G(SDDATA),"^",8)=0 S V=0
Q I SDBC,(SDY+5)>$Y F I=1:1 Q:(SDY+5)'>$Y W !
I SDBC W !?9,$E(SDASH,9,255)
S SDPCT=SDPCT+1 K V,SDX,SDMT,VAQK Q
;
GETA K SDCP S SDZ(3)=$P($G(SDDATA),"^",21),SDZ(4)=$P($G(SDDATA),"^",20),SDZ(5)=$P($G(SDDATA),"^",19)
S SDEM="",SDEC=+VAQK(6) Q:'SDEC
S SDXX=$S('$D(^DIC(8,SDEC,0)):1,$P(^(0),"^",5)'="Y":1,$P(^(0),"^",4)=4:0,$P(^(0),"^",4)=5:0,1:1) Q:SDXX
I $D(^SC(SC,"SL")),$P(^("SL"),U,5)]"",$D(^SC($P(^("SL"),U,5),0)) S SDCP=$P(^SC(SC,"SL"),U,5)
S SDCP=$S($D(SDCP):SDCP,1:SC) I $D(^DPT(DFN,"DE","B",SDCP)),VAQK(12)']"" S SDEA=$O(^DPT(DFN,"DE","B",SDCP,0)) I $D(^DPT(DFN,"DE",+SDEA,0)),$P(^(0),"^",2)']"",$O(^(1,0))'="" D CKCED
Q
;
MORE K SDFS S PT=SDT D PTL
Q
;
CCLK S SDCC=0 F S SDCC=$O(^SC(SC,"C",SDD,1,SDCC)) Q:'SDCC!SDEND S SDPT0=$G(^DPT(+^(SDCC,0),0)) I $L(SDPT0) D
.I ($Y+4>IOSL) D HED^SDAL Q:SDEND W !
.W !,"CHART REQUEST: ",$P(SDPT0,"^",1),?34,$P(SDPT0,"^",9)
Q
;
CKCED S A=0 F S A=$O(^DPT(DFN,"DE",SDEA,1,A)) Q:'A I $P(^DPT(DFN,"DE",SDEA,1,A,0),"^",3)']"" D ENR Q
Q
;
ENR S SDEDT=$P(^(0),"^",1)\1,SDDIF=DT-SDEDT,SDREV=$P(^(0),"^",5),SDDIF1=$S(SDREV:DT-SDREV,1:"") ;NAKED REFERENCE - ^DPT(DFN,"DE",SDEA,1,A,0)
I $P(^DPT(DFN,"DE",SDEA,1,A,0),"^",2)="O",$S(SDDIF1']""&(SDDIF>10000):1,SDDIF1>10000:1,1:0) S SDEM="PATIENT HAS BEEN ENROLLED IN ",SDEM1="FOR MORE THAN 1 YEAR, PLEASE RE-EVALUATE"
Q
;
CHECK() I $D(^SC(SC,0)),$P(^(0),"^",3)="C",$S(VAUTD:1,$D(VAUTD(+$P(^(0),"^",15))):1,'$P(^(0),"^",15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)
I $T,$D(^SC(SC,"ST",SDD,1)),^(1)'["**CANCELLED",$S('$D(^SC(SC,"I")):1,+^("I")'>0:1,+^("I")>SDD:1,+^("I")'>SDD&(+$P(^("I"),"^",2)>SDD!(+$P(^("I"),"^",2)=0)):0,1:1) Q 1
Q 0
;
NCOUNT ;COUNT, NON-COUNT, or BOTH FOR CLINIC SELECTION
W !,"Count, Non Count, or Both: C//" R SDCONC:DTIME
I '$T!(SDCONC="") S SDCONC="C" Q
Q:SDCONC=U
I $L(SDCONC)=1,$E(SDCONC)="?" W !,"Type C, N or B" G NCOUNT
I $E(SDCONC,1,2)="??" D G NCOUNT
. W !!,"Choosing ""C"" will limit the selection to COUNT clinics."
. W !," ""N"" will limit the selection to NON COUNT clinics."
. W !," ""B"" will give BOTH count and non count clinics.",!
S SDCONC=$E(SDCONC),SDCONC=$TR(SDCONC,"bcn","BCN")
I "BCN"'[SDCONC W !,"C, N or B" G NCOUNT
Q
;
NCHECK() ;EXTEND $T LOGIC COUNT, NO COUNT,or BOTH
N NOC S NOC=$P($G(^SC(SC,0)),U,17)
I SDCONC="B" Q 1
I SDCONC="C"&(NOC="N") Q 1
I SDCONC="N"&(NOC="Y") Q 1
Q 0
;
NCLINIC ;SCREEN CLINICS
N NOCC
I SDCONC="B" S NOCC="&1"
I SDCONC="N" S NOCC="&($P(^(0),U,17)=""Y"")"
I SDCONC="C" S NOCC="&($P(^(0),U,17)=""N"")"
S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C""&'$G(^(""OOS""))"_NOCC_"&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)",VAUTSTR="clinic",VAUTVB="VAUTC" G FIRST^VAUTOMA
;
ACTIVE() ;Determine if clinic has activity to print
;Output: '1' if activity or selected clinic, '0' otherwise
Q:'VAUTC 1 ;selected clinics
Q:$O(^SC(SC,"C",SDD,1,0)) 1 ;chart request list
;if clinic has no appts, return 0
S SDX=1 I '$D(^TMP($J,"SDAMA301",SC)) S SDX=0
Q SDX
SDAL0 ;ALB/GRR,TMP,MJK - APPOINTMENT LIST (CONTINUED FROM SDAL) ; 29 Jun 99 04:11PM
+1 ;;5.3;PIMS;**28,37,106,149,171,177,193,305,373,266,1015,1016**;JUN 30, 2012;Build 20
LOOP IF 'VAUTC
IF $GET(^SC(SC,"ST",SDD,1))["CANCELLED"
Begin DoDot:1
+1 SET SDPAGE=1
DO HED^SDAL
+2 SET SDPCT="Clinic cancelled for this date!"
+3 WRITE !!?(IOM-$LENGTH(SDPCT)\2),SDPCT
End DoDot:1
QUIT
+4 IF $$CHECK()
IF $$NCHECK()
IF $$ACTIVE()
Begin DoDot:1
+5 ;SD*572 set flag
SET SDPAGE=1
DO HED^SDAL
IF SDEND
QUIT
SET SDPCT=0
SET SDFLG=1
+6 ;loop through sorted appointment data for the clinic
+7 NEW SDT,SDDFN,SDDATA,SDDATAC
SET SDT=""
FOR
SET SDT=$ORDER(^TMP($JOB,"SDAMA301","S",SC,SDT))
IF 'SDT
QUIT
Begin DoDot:2
+8 SET SDDFN=""
FOR
SET SDDFN=$ORDER(^TMP($JOB,"SDAMA301","S",SC,SDT,SDDFN))
IF 'SDDFN!SDEND
QUIT
Begin DoDot:3
+9 ;store appt data and comments for later reference
+10 SET SDDATA=$GET(^TMP($JOB,"SDAMA301","S",SC,SDT,SDDFN))
SET SDDATAC=$GET(^(SDDFN,"C"))
+11 DO MORE
End DoDot:3
End DoDot:2
+12 WRITE !
DO CCLK
IF SDEND
QUIT
+13 IF 'SDPCT
SET SDPCT="No activity found for this clinic date!"
WRITE !!?(IOM-$LENGTH(SDPCT)\2),SDPCT
End DoDot:1
+14 SET SDPAGE=1
QUIT
+15 ;
PTL NEW SDAPPT
+1 SET DFN=+$PIECE(SDDATA,"^",4)
SET SDOI=$GET(SDDATAC)
+2 SET SDAPPT=""
+3 DO ^VAUQWK
DO GETA
+4 IF ($Y+7>IOSL)
DO HED^SDAL
IF SDEND
QUIT
+5 IF '$DATA(SDFS)
SET SDFS=1
SET X=PT
DO TM^SDROUT0
WRITE !,$JUSTIFY(X,8)
+6 NEW SDCLY
DO CL^SDCO21(DFN,SDT,"",.SDCLY)
+7 NEW SDY
SET SDY=$Y
+8 WRITE !
IF SDBC
DO BARC^SDAL(85,$PIECE(VAQK(2),"^"))
+9 ;check for Combat Vet
+10 NEW SDCV
+11 SET SDCV=$$CVEDT^DGCV(DFN,$GET(SDD))
+12 SET SDCV=$PIECE(SDCV,U,3)
+13 WRITE !?3,$SELECT($GET(SDCV)=1:"(CV)",1:""),?9,$SELECT($PIECE(SDDATA,"^",7)="Y":"*",1:""),?10,$SELECT(VAQK(1)]"":VAQK(1),1:"UNKNOWN PATIENT"),?41,$SELECT(VAQK(2)]"":$EXTRACT(VAQK(2),1,9),1:"")
+14 SET INC=0
FOR SDZ=3,4,5
SET X=SDZ(SDZ)
IF X]""
DO TM^SDROUT0
SET INC=SDZ#3*8+3
WRITE ?48+INC,$JUSTIFY(X,8)
IF INC<16
WRITE " "
+15 IF VAQK(12)]""
WRITE !,?41,VAQK(12)
IF VAQK(13)]""
WRITE !,?41,VAQK(13)
+16 IF SDOI]""
WRITE !,?15,SDOI
IF SDEM]""
WRITE !,?15,SDEM,$SELECT($DATA(SDCP):$PIECE(^SC(SDCP,0),"^"),1:$PIECE(^SC(SC,0),"^")),!,?15,SDEM1
+17 ;Phone Number [Residence]
WRITE !,?10,"Phone #: ",$PIECE($GET(^DPT(DFN,.13)),"^",1)
+18 SET SDX=""
FOR I=7:1:9
IF VAQK(I)
SET SDX=1
QUIT
+19 ;Primary Care information
+20 IF +$GET(SDPCMM)
DO TDATA^SDPPTEM(DFN,"",SDD,"P",15)
+21 ;; GAF SCORE CHECK
+22 NEW SDGAF,SDGAFST
+23 ;use Appt Type here since COLLATERAL VISIT field not supported by encapsulation API
+24 IF $$MHCLIN^SDUTL2(SC)
IF '($$COLLAT^SDUTL2(+VAQK(6))!$PIECE($PIECE(SDDATA,"^",10),";",2)["COLLATERAL OF VET")
Begin DoDot:1
+25 SET SDGAF=$$NEWGAF^SDUTL2(DFN)
SET SDGAFST=$PIECE(SDGAF,"^")
+26 IF SDGAFST
WRITE !,?15,"** New GAF Score Required **"
End DoDot:1
+27 ;;
+28 IF $ORDER(SDCLY(0))
Begin DoDot:1
+29 NEW PCL
+30 SET PCL=0
+31 WRITE !,?15,"** Required for facility workload credit => "
+32 FOR
SET PCL=$ORDER(SDCLY(PCL))
IF 'PCL
QUIT
Begin DoDot:2
+33 WRITE " ",SDCLAR(PCL)," "
+34 IF (SDCLAR(PCL)="SC")&($GET(^DPT(DFN,0))]"")
Begin DoDot:3
+35 KILL SDELAR
+36 SET VAROOT="SDELAR"
+37 DO ELIG^VADPT
+38 IF '$PIECE($GET(SDELAR(3)),"^")
QUIT
+39 WRITE $PIECE(SDELAR(3),"^",2),"% "
+40 KILL SDELAR,VAROOT
End DoDot:3
End DoDot:2
+41 WRITE "**"
End DoDot:1
+42 IF $PIECE(VAQK(11),"^",2)]""
WRITE !,?15,"Means Test: ** ",$PIECE(VAQK(11),"^",2)," **"
WRITE " Last Test: ",$$FDATE^SDUL1($PIECE($$LST^DGMTU(DFN),U,2))
+43 SET SDCOPS=$$LST^DGMTU(DFN,DT,2)
IF +SDCOPS
WRITE !,?15,"Co-Pay Status: ","**"_$PIECE(SDCOPS,U,3)_"**"," Last Test: ",$$FDATE^SDUL1($PIECE(SDCOPS,U,2))
KILL SDCOPS
+44 IF $DATA(^DIC(8,+VAQK(6),0))
IF $PIECE(^(0),U,9)=13
WRITE !,?15,"** COLLATERAL **"
GOTO Q
+45 IF +$PIECE(SDDATA,"^",8)]""
Begin DoDot:1
+46 SET V=+$PIECE(SDDATA,"^",8)
SET V=$SELECT($DATA(^DIC(8,+V,0)):$PIECE(^(0),"^",9)=13,1:0)
End DoDot:1
IF V
WRITE !,?15,"** COLLATERAL **"
GOTO Q
+47 ;use Appt Type here since COLLATERAL VISIT field not supported by encapsulation API
+48 IF $PIECE($PIECE(SDDATA,"^",10),";",2)["COLLATERAL OF VET"
WRITE !,?15,"** COLLATERAL VISIT **"
+49 IF +$PIECE($GET(SDDATA),"^",8)=0
SET V=0
Q IF SDBC
IF (SDY+5)>$Y
FOR I=1:1
IF (SDY+5)'>$Y
QUIT
WRITE !
+1 IF SDBC
WRITE !?9,$EXTRACT(SDASH,9,255)
+2 SET SDPCT=SDPCT+1
KILL V,SDX,SDMT,VAQK
QUIT
+3 ;
GETA KILL SDCP
SET SDZ(3)=$PIECE($GET(SDDATA),"^",21)
SET SDZ(4)=$PIECE($GET(SDDATA),"^",20)
SET SDZ(5)=$PIECE($GET(SDDATA),"^",19)
+1 SET SDEM=""
SET SDEC=+VAQK(6)
IF 'SDEC
QUIT
+2 SET SDXX=$SELECT('$DATA(^DIC(8,SDEC,0)):1,$PIECE(^(0),"^",5)'="Y":1,$PIECE(^(0),"^",4)=4:0,$PIECE(^(0),"^",4)=5:0,1:1)
IF SDXX
QUIT
+3 IF $DATA(^SC(SC,"SL"))
IF $PIECE(^("SL"),U,5)]""
IF $DATA(^SC($PIECE(^("SL"),U,5),0))
SET SDCP=$PIECE(^SC(SC,"SL"),U,5)
+4 SET SDCP=$SELECT($DATA(SDCP):SDCP,1:SC)
IF $DATA(^DPT(DFN,"DE","B",SDCP))
IF VAQK(12)']""
SET SDEA=$ORDER(^DPT(DFN,"DE","B",SDCP,0))
IF $DATA(^DPT(DFN,"DE",+SDEA,0))
IF $PIECE(^(0),"^",2)']""
IF $ORDER(^(1,0))'=""
DO CKCED
+5 QUIT
+6 ;
MORE KILL SDFS
SET PT=SDT
DO PTL
+1 QUIT
+2 ;
CCLK SET SDCC=0
FOR
SET SDCC=$ORDER(^SC(SC,"C",SDD,1,SDCC))
IF 'SDCC!SDEND
QUIT
SET SDPT0=$GET(^DPT(+^(SDCC,0),0))
IF $LENGTH(SDPT0)
Begin DoDot:1
+1 IF ($Y+4>IOSL)
DO HED^SDAL
IF SDEND
QUIT
WRITE !
+2 WRITE !,"CHART REQUEST: ",$PIECE(SDPT0,"^",1),?34,$PIECE(SDPT0,"^",9)
End DoDot:1
+3 QUIT
+4 ;
CKCED SET A=0
FOR
SET A=$ORDER(^DPT(DFN,"DE",SDEA,1,A))
IF 'A
QUIT
IF $PIECE(^DPT(DFN,"DE",SDEA,1,A,0),"^",3)']""
DO ENR
QUIT
+1 QUIT
+2 ;
ENR ;NAKED REFERENCE - ^DPT(DFN,"DE",SDEA,1,A,0)
SET SDEDT=$PIECE(^(0),"^",1)\1
SET SDDIF=DT-SDEDT
SET SDREV=$PIECE(^(0),"^",5)
SET SDDIF1=$SELECT(SDREV:DT-SDREV,1:"")
+1 IF $PIECE(^DPT(DFN,"DE",SDEA,1,A,0),"^",2)="O"
IF $SELECT(SDDIF1']""&(SDDIF>10000):1,SDDIF1>10000:1,1:0)
SET SDEM="PATIENT HAS BEEN ENROLLED IN "
SET SDEM1="FOR MORE THAN 1 YEAR, PLEASE RE-EVALUATE"
+2 QUIT
+3 ;
CHECK() IF $DATA(^SC(SC,0))
IF $PIECE(^(0),"^",3)="C"
IF $SELECT(VAUTD:1,$DATA(VAUTD(+$PIECE(^(0),"^",15))):1,'$PIECE(^(0),"^",15)&$DATA(VAUTD(+$ORDER(^DG(40.8,0)))):1,1:0)
+1 IF $TEST
IF $DATA(^SC(SC,"ST",SDD,1))
IF ^(1)'["**CANCELLED"
IF $SELECT('$DATA(^SC(SC,"I")):1,+^("I")'>0:1,+^("I")>SDD:1,+^("I")'>SDD&(+$PIECE(^("I"),"^",2)>SDD!(+$PIECE(^("I"),"^",2)=0)):0,1:1)
QUIT 1
+2 QUIT 0
+3 ;
NCOUNT ;COUNT, NON-COUNT, or BOTH FOR CLINIC SELECTION
+1 WRITE !,"Count, Non Count, or Both: C//"
READ SDCONC:DTIME
+2 IF '$TEST!(SDCONC="")
SET SDCONC="C"
QUIT
+3 IF SDCONC=U
QUIT
+4 IF $LENGTH(SDCONC)=1
IF $EXTRACT(SDCONC)="?"
WRITE !,"Type C, N or B"
GOTO NCOUNT
+5 IF $EXTRACT(SDCONC,1,2)="??"
Begin DoDot:1
+6 WRITE !!,"Choosing ""C"" will limit the selection to COUNT clinics."
+7 WRITE !," ""N"" will limit the selection to NON COUNT clinics."
+8 WRITE !," ""B"" will give BOTH count and non count clinics.",!
End DoDot:1
GOTO NCOUNT
+9 SET SDCONC=$EXTRACT(SDCONC)
SET SDCONC=$TRANSLATE(SDCONC,"bcn","BCN")
+10 IF "BCN"'[SDCONC
WRITE !,"C, N or B"
GOTO NCOUNT
+11 QUIT
+12 ;
NCHECK() ;EXTEND $T LOGIC COUNT, NO COUNT,or BOTH
+1 NEW NOC
SET NOC=$PIECE($GET(^SC(SC,0)),U,17)
+2 IF SDCONC="B"
QUIT 1
+3 IF SDCONC="C"&(NOC="N")
QUIT 1
+4 IF SDCONC="N"&(NOC="Y")
QUIT 1
+5 QUIT 0
+6 ;
NCLINIC ;SCREEN CLINICS
+1 NEW NOCC
+2 IF SDCONC="B"
SET NOCC="&1"
+3 IF SDCONC="N"
SET NOCC="&($P(^(0),U,17)=""Y"")"
+4 IF SDCONC="C"
SET NOCC="&($P(^(0),U,17)=""N"")"
+5 SET DIC="^SC("
SET DIC("S")="I $P(^(0),U,3)=""C""&'$G(^(""OOS""))"_NOCC_"&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"
SET VAUTSTR="clinic"
SET VAUTVB="VAUTC"
GOTO FIRST^VAUTOMA
+6 ;
ACTIVE() ;Determine if clinic has activity to print
+1 ;Output: '1' if activity or selected clinic, '0' otherwise
+2 ;selected clinics
IF 'VAUTC
QUIT 1
+3 ;chart request list
IF $ORDER(^SC(SC,"C",SDD,1,0))
QUIT 1
+4 ;if clinic has no appts, return 0
+5 SET SDX=1
IF '$DATA(^TMP($JOB,"SDAMA301",SC))
SET SDX=0
+6 QUIT SDX
