- 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
