APCLDE3P ; IHS/CMI/LAB - list refusals ; 10 Dec 2009 3:03 PM
;;2.0;IHS PCC SUITE;**2,10**;MAY 14, 2009;Build 88
;
;
PRINT ;EP - called from xbdbque
D PRINT1
D DONE
Q
PRINT1 ;
S APCLPG=0 K APCLQUIT
K APCLLSTP
I '$D(^XTMP("APCLDE3",APCLJ,APCLH)) D HEADER W !!,"No data to report.",! G DONE
D COVPAGE
Q:$$END
D HEADER
S APCLTOT=APCLCNT
S APCLPTOT=$$PTOT
W !," Total Number of Visits with Screening",?40,$J($$COM(APCLTOT,0),8)
W !," Total Number of Patients Screened",?40,$J($$COM(APCLPTOT,0),8)
D LIST
Q
COM(X,X2,X3) ;
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
END() ;
I $Y<(IOSL-3) Q 0
D HEADER
I $D(APCLQUIT) Q 1
Q 0
ENDL() ;
I $Y<(IOSL-8) Q 0
D HEADER
I $D(APCLQUIT) Q 1
Q 0
PTOT() ;
NEW C,X
S C=0
S X=0 F S X=$O(^XTMP("APCLDE3",APCLJ,APCLH,"PTS",X)) Q:X'=+X S C=C+1
Q C
TOT() ;
NEW C,X
S C=0
S X=0 F S X=$O(^XTMP("APCLDE3",APCLJ,APCLH,"VSTS",X)) Q:X'=+X S C=C+1
Q C
G:'APCLPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
W !,$$CTR("*** DEPRESSION SCREENING VISIT LISTING FOR SELECTED PATIENTS ***",80),!
S X="Screening Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
W !?35,"DATE",!,"PATIENT NAME",?22,"HRN",?29,"AGE",?35,"SCREENED",?55,"CLINIC"
W !,$TR($J("",80)," ","-")
Q
DONE ;
K ^TMP($J)
K ^XTMP("APCLDE3",APCLJ,APCLH)
D EOP
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:IO'=IO(0)
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
W !
S DIR("A")="End of Report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
LIST ;EP - called from xbdbque
S APCLPG=0 K APCLQUIT
S APCLLSTP=1
D HEADER
K ^TMP($J)
;resort by sort item
S APCLX=0 F S APCLX=$O(^XTMP("APCLDE3",APCLJ,APCLH,"PTS",APCLX)) Q:APCLX'=+APCLX S APCLY=^XTMP("APCLDE3",APCLJ,APCLH,"PTS",APCLX) D
.S DFN=APCLX
.D @APCLSORT
.I APCLSORV="" S APCLSORV="--"
.S ^TMP($J,"PTS",APCLSORV,APCLX)=APCLY
.Q
S APCLSORV="" F S APCLSORV=$O(^TMP($J,"PTS",APCLSORV)) Q:APCLSORV=""!($D(APCLQUIT)) D
.S DFN=0 F S DFN=$O(^TMP($J,"PTS",APCLSORV,DFN)) Q:DFN'=+DFN!($D(APCLQUIT)) D
..Q:$$ENDL
..S APCLY=^TMP($J,"PTS",APCLSORV,DFN)
..W !!,$E($P(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$P(APCLY,U,4),?33,$P(^DPT(DFN,0),U,2),?35,$$DT($P(APCLY,U,1)),?55,$E($P(APCLY,U,6),1,20)
..W !?3,"Type/Result: ",$P($P(APCLY,U,2),";")_" "_$P($P(APCLY,U,2),";",2)
..I $P(APCLY,U,12)]"" W !?3,"Comment: ",$P(APCLY,U,12)
..I $P(APCLY,U,20)="PCC" S APCLV=$P(APCLY,U,14) I APCLV,$D(^AUPNVPOV("AD",APCLV)) D
...S APCLC=0 W !?3,"DXs: "
...S APCLX=0 F S APCLX=$O(^AUPNVPOV("AD",APCLV,APCLX)) Q:APCLX'=+APCLX!($D(APCLQUIT)) D
....S APCLC=APCLC+1
....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCLX,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCLX,.04),1,60)
..I $P(APCLY,U,20)="BH" S APCLV=$P(APCLY,U,15) I APCLV,$D(^AMHRPRO("AD",APCLV)) D
...S APCLC=0 W !?3,"DXs: "
...S APCLX=0 F S APCLX=$O(^AMHRPRO("AD",APCLV,APCLX)) Q:APCLX'=+APCLX!($D(APCLQUIT)) D
....S APCLC=APCLC+1
....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9002011.01,APCLX,.01),?17,$E($$VAL^XBDIQ1(9002011.01,APCLX,.04),1,60)
..W !?3,"Primary Provider on Visit: ",?31,$P(APCLY,U,7)
..W !?3," Provider who screened: ",?31,$P(APCLY,U,5)
Q
H ;
S APCLSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
Q
N ;
S APCLSORV=$P(^DPT(DFN,0),U)
Q
P ;
S APCLSORV=$P(APCLY,U,5)
Q
R ;
S APCLSORV=$P($P(APCLY,U,2),";")_" "_$P($P(APCLY,U,2),";",2)
Q
D ;
S APCLSORV=$P(APCLY,U,1)
Q
A S APCLSORV=$P(APCLY,U,4)
Q
G ;
S APCLSORV=$P(APCLY,U,3)
Q
C ;
S APCLSORV=$P(APCLY,U,6)
Q
T ;
S %=$$HRN^AUPNPAT(DFN,DUZ(2))
S %=%+10000000,%=$E(%,7,8)_"-"_+$E(%,2,8)
S APCLSORV=%
Q
DT(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
;
COVPAGE ;EP
W:$D(IOF) @IOF
W !,$$CTR("********** DEPRESSION SCREENING FOR SELECTED PATIENTS **********",80)
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !!,"The following report contains an DEPRESSION screening report based on the",!,"following criteria:"
SHOW ;
W !!?6,"Patient must have had a screening between ",$$FMTE^XLFDT(APCLBD)," and ",$$FMTE^XLFDT(APCLED),!
;W:APCLTYPE="S" !!?6,"Search Template: ",$P(^DIBT(APCLSEAT,0),U),!
W !?6,"Gender: ",$S(APCLSEX="F":"FEMALES ONLY",APCLSEX="M":"MALES ONLY",APCLSEX="U":"UNKNOWN",APCLSEX="MFU":"ALL GENDERS",1:"")
I $D(APCLAGET) W !?6,"Age of Patients included: ",$P(APCLAGET,"-")," to ",$P(APCLAGET,"-",2)
I '$D(APCLAGET) W !?6,"All Ages included"
W !?6,"Patients must have had a screening during the time period with one of ",!?6,"the following screening results:"
W ! S X="" F S X=$O(APCLREST(X)) Q:X'=+X D
.I X=1 W ?8,"NEGATIVE"
.I X=2 W " ","POSITIVE"
.I X=3 W " ","REFUSED"
.I X=4 W " ","UNABLE TO SCREEN"
.I X=5 W !?8,"SCREENINGS WITH NO RECORDED RESULT"
I $D(APCLCLNT) W !,"Screenings done in the following clinics are included:" D
.S X=0 F S X=$O(APCLCLNT(X)) Q:X'=+X W !?10,$P(^DIC(40.7,X,0),U)," ("_$P(^DIC(40.7,X,0),U,2)_")"
I '$D(APCLCLNT),APCLEXPC W !,"Screenings done in ALL clinics included"
I 'APCLEXPC W !,"BH Clinics excluded."
I APCLDESP]"" W !,"Only patients whose Designated Mental Health Provider",!?6,$P(^VA(200,APCLDESP,0),U)," are included"
I APCLSSP]"" W !,"Only patients whose Designated Social Services Provider",!?6,$P(^VA(200,APCLSSP,0),U)," are included"
I APCLCDP]"" W !,"Only patients whose Designated ASA/CD Provider",!?6,$P(^VA(200,APCLCDP,0),U)," are included"
I APCLPPUN W !,"Only patients who had a visit on which a screeening was done",!?6,"but the primary provider on the visit was UNKNOWN are included."
I APCLSPUN W !,"Only patients who had a visit on which a screeening was done",!?6,"but the screening provider on the visit was UNKNOWN are included."
I '$D(APCLPROV) W !,"Visits to any Primary Provider are included"
I '$D(APCLSPRV) W !,"Visits on which any provider did the screening are included"
I $D(APCLPROV) W !,"Only screenings on which ",$P(^VA(200,APCLPROV,0),U)," was the primary provider",!?6,"on the visit are included"
I $D(APCLSPRV) W !,"Only screenings on which ",$P(^VA(200,APCLSPRV,0),U)," was the primary provider",!?6,"on the visit are included"
D PAUSE
Q
PAUSE ;
Q:$E(IOST)'="C"
Q:IO'=IO(0)
S DIR(0)="E",DIR("A")="Press return to continue or '^' to quit" D ^DIR K DIR,DA
S:$D(DIRUT) APCLQUIT=1
W:$D(IOF) @IOF
Q
APCLDE3P ; IHS/CMI/LAB - list refusals ; 10 Dec 2009 3:03 PM
+1 ;;2.0;IHS PCC SUITE;**2,10**;MAY 14, 2009;Build 88
+2 ;
+3 ;
PRINT ;EP - called from xbdbque
+1 DO PRINT1
+2 DO DONE
+3 QUIT
PRINT1 ;
+1 SET APCLPG=0
KILL APCLQUIT
+2 KILL APCLLSTP
+3 IF '$DATA(^XTMP("APCLDE3",APCLJ,APCLH))
DO HEADER
WRITE !!,"No data to report.",!
GOTO DONE
+4 DO COVPAGE
+5 IF $$END
QUIT
+6 DO HEADER
+7 SET APCLTOT=APCLCNT
+8 SET APCLPTOT=$$PTOT
+9 WRITE !," Total Number of Visits with Screening",?40,$JUSTIFY($$COM(APCLTOT,0),8)
+10 WRITE !," Total Number of Patients Screened",?40,$JUSTIFY($$COM(APCLPTOT,0),8)
+11 DO LIST
+12 QUIT
COM(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT $$STRIP^XLFSTR(X," ")
END() ;
+1 IF $Y<(IOSL-3)
QUIT 0
+2 DO HEADER
+3 IF $DATA(APCLQUIT)
QUIT 1
+4 QUIT 0
ENDL() ;
+1 IF $Y<(IOSL-8)
QUIT 0
+2 DO HEADER
+3 IF $DATA(APCLQUIT)
QUIT 1
+4 QUIT 0
PTOT() ;
+1 NEW C,X
+2 SET C=0
+3 SET X=0
FOR
SET X=$ORDER(^XTMP("APCLDE3",APCLJ,APCLH,"PTS",X))
IF X'=+X
QUIT
SET C=C+1
+4 QUIT C
TOT() ;
+1 NEW C,X
+2 SET C=0
+3 SET X=0
FOR
SET X=$ORDER(^XTMP("APCLDE3",APCLJ,APCLH,"VSTS",X))
IF X'=+X
QUIT
SET C=C+1
+4 QUIT C
+1 IF 'APCLPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
+3 WRITE !,$$CTR("*** DEPRESSION SCREENING VISIT LISTING FOR SELECTED PATIENTS ***",80),!
+4 SET X="Screening Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED)
WRITE $$CTR(X,80),!
+5 WRITE !?35,"DATE",!,"PATIENT NAME",?22,"HRN",?29,"AGE",?35,"SCREENED",?55,"CLINIC"
+6 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+7 QUIT
DONE ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("APCLDE3",APCLJ,APCLH)
+3 DO EOP
+4 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF IO'=IO(0)
QUIT
+3 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+4 NEW DIR
+5 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+6 WRITE !
+7 SET DIR("A")="End of Report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+8 QUIT
+9 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
LIST ;EP - called from xbdbque
+1 SET APCLPG=0
KILL APCLQUIT
+2 SET APCLLSTP=1
+3 DO HEADER
+4 KILL ^TMP($JOB)
+5 ;resort by sort item
+6 SET APCLX=0
FOR
SET APCLX=$ORDER(^XTMP("APCLDE3",APCLJ,APCLH,"PTS",APCLX))
IF APCLX'=+APCLX
QUIT
SET APCLY=^XTMP("APCLDE3",APCLJ,APCLH,"PTS",APCLX)
Begin DoDot:1
+7 SET DFN=APCLX
+8 DO @APCLSORT
+9 IF APCLSORV=""
SET APCLSORV="--"
+10 SET ^TMP($JOB,"PTS",APCLSORV,APCLX)=APCLY
+11 QUIT
End DoDot:1
+12 SET APCLSORV=""
FOR
SET APCLSORV=$ORDER(^TMP($JOB,"PTS",APCLSORV))
IF APCLSORV=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+13 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"PTS",APCLSORV,DFN))
IF DFN'=+DFN!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+14 IF $$ENDL
QUIT
+15 SET APCLY=^TMP($JOB,"PTS",APCLSORV,DFN)
+16 WRITE !!,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$PIECE(APCLY,U,4),?33,$PIECE(^DPT(DFN,0),U,2),?35,$$DT($PIECE(APCLY,U,1)),?55,$EXTRACT($PIECE(APCLY,U,6),1,20)
+17 WRITE !?3,"Type/Result: ",$PIECE($PIECE(APCLY,U,2),";")_" "_$PIECE($PIECE(APCLY,U,2),";",2)
+18 IF $PIECE(APCLY,U,12)]""
WRITE !?3,"Comment: ",$PIECE(APCLY,U,12)
+19 IF $PIECE(APCLY,U,20)="PCC"
SET APCLV=$PIECE(APCLY,U,14)
IF APCLV
IF $DATA(^AUPNVPOV("AD",APCLV))
Begin DoDot:3
+20 SET APCLC=0
WRITE !?3,"DXs: "
+21 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUPNVPOV("AD",APCLV,APCLX))
IF APCLX'=+APCLX!($DATA(APCLQUIT))
QUIT
Begin DoDot:4
+22 SET APCLC=APCLC+1
+23 IF APCLC'=1
WRITE !
WRITE ?8,$$VAL^XBDIQ1(9000010.07,APCLX,.01),?17,$EXTRACT($$VAL^XBDIQ1(9000010.07,APCLX,.04),1,60)
End DoDot:4
End DoDot:3
+24 IF $PIECE(APCLY,U,20)="BH"
SET APCLV=$PIECE(APCLY,U,15)
IF APCLV
IF $DATA(^AMHRPRO("AD",APCLV))
Begin DoDot:3
+25 SET APCLC=0
WRITE !?3,"DXs: "
+26 SET APCLX=0
FOR
SET APCLX=$ORDER(^AMHRPRO("AD",APCLV,APCLX))
IF APCLX'=+APCLX!($DATA(APCLQUIT))
QUIT
Begin DoDot:4
+27 SET APCLC=APCLC+1
+28 IF APCLC'=1
WRITE !
WRITE ?8,$$VAL^XBDIQ1(9002011.01,APCLX,.01),?17,$EXTRACT($$VAL^XBDIQ1(9002011.01,APCLX,.04),1,60)
End DoDot:4
End DoDot:3
+29 WRITE !?3,"Primary Provider on Visit: ",?31,$PIECE(APCLY,U,7)
+30 WRITE !?3," Provider who screened: ",?31,$PIECE(APCLY,U,5)
End DoDot:2
End DoDot:1
+31 QUIT
H ;
+1 SET APCLSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
+2 QUIT
N ;
+1 SET APCLSORV=$PIECE(^DPT(DFN,0),U)
+2 QUIT
P ;
+1 SET APCLSORV=$PIECE(APCLY,U,5)
+2 QUIT
R ;
+1 SET APCLSORV=$PIECE($PIECE(APCLY,U,2),";")_" "_$PIECE($PIECE(APCLY,U,2),";",2)
+2 QUIT
D ;
+1 SET APCLSORV=$PIECE(APCLY,U,1)
+2 QUIT
A SET APCLSORV=$PIECE(APCLY,U,4)
+1 QUIT
G ;
+1 SET APCLSORV=$PIECE(APCLY,U,3)
+2 QUIT
C ;
+1 SET APCLSORV=$PIECE(APCLY,U,6)
+2 QUIT
T ;
+1 SET %=$$HRN^AUPNPAT(DFN,DUZ(2))
+2 SET %=%+10000000
SET %=$EXTRACT(%,7,8)_"-"_+$EXTRACT(%,2,8)
+3 SET APCLSORV=%
+4 QUIT
DT(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+3 ;
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("********** DEPRESSION SCREENING FOR SELECTED PATIENTS **********",80)
+3 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+4 WRITE !!,"The following report contains an DEPRESSION screening report based on the",!,"following criteria:"
SHOW ;
+1 WRITE !!?6,"Patient must have had a screening between ",$$FMTE^XLFDT(APCLBD)," and ",$$FMTE^XLFDT(APCLED),!
+2 ;W:APCLTYPE="S" !!?6,"Search Template: ",$P(^DIBT(APCLSEAT,0),U),!
+3 WRITE !?6,"Gender: ",$SELECT(APCLSEX="F":"FEMALES ONLY",APCLSEX="M":"MALES ONLY",APCLSEX="U":"UNKNOWN",APCLSEX="MFU":"ALL GENDERS",1:"")
+4 IF $DATA(APCLAGET)
WRITE !?6,"Age of Patients included: ",$PIECE(APCLAGET,"-")," to ",$PIECE(APCLAGET,"-",2)
+5 IF '$DATA(APCLAGET)
WRITE !?6,"All Ages included"
+6 WRITE !?6,"Patients must have had a screening during the time period with one of ",!?6,"the following screening results:"
+7 WRITE !
SET X=""
FOR
SET X=$ORDER(APCLREST(X))
IF X'=+X
QUIT
Begin DoDot:1
+8 IF X=1
WRITE ?8,"NEGATIVE"
+9 IF X=2
WRITE " ","POSITIVE"
+10 IF X=3
WRITE " ","REFUSED"
+11 IF X=4
WRITE " ","UNABLE TO SCREEN"
+12 IF X=5
WRITE !?8,"SCREENINGS WITH NO RECORDED RESULT"
End DoDot:1
+13 IF $DATA(APCLCLNT)
WRITE !,"Screenings done in the following clinics are included:"
Begin DoDot:1
+14 SET X=0
FOR
SET X=$ORDER(APCLCLNT(X))
IF X'=+X
QUIT
WRITE !?10,$PIECE(^DIC(40.7,X,0),U)," ("_$PIECE(^DIC(40.7,X,0),U,2)_")"
End DoDot:1
+15 IF '$DATA(APCLCLNT)
IF APCLEXPC
WRITE !,"Screenings done in ALL clinics included"
+16 IF 'APCLEXPC
WRITE !,"BH Clinics excluded."
+17 IF APCLDESP]""
WRITE !,"Only patients whose Designated Mental Health Provider",!?6,$PIECE(^VA(200,APCLDESP,0),U)," are included"
+18 IF APCLSSP]""
WRITE !,"Only patients whose Designated Social Services Provider",!?6,$PIECE(^VA(200,APCLSSP,0),U)," are included"
+19 IF APCLCDP]""
WRITE !,"Only patients whose Designated ASA/CD Provider",!?6,$PIECE(^VA(200,APCLCDP,0),U)," are included"
+20 IF APCLPPUN
WRITE !,"Only patients who had a visit on which a screeening was done",!?6,"but the primary provider on the visit was UNKNOWN are included."
+21 IF APCLSPUN
WRITE !,"Only patients who had a visit on which a screeening was done",!?6,"but the screening provider on the visit was UNKNOWN are included."
+22 IF '$DATA(APCLPROV)
WRITE !,"Visits to any Primary Provider are included"
+23 IF '$DATA(APCLSPRV)
WRITE !,"Visits on which any provider did the screening are included"
+24 IF $DATA(APCLPROV)
WRITE !,"Only screenings on which ",$PIECE(^VA(200,APCLPROV,0),U)," was the primary provider",!?6,"on the visit are included"
+25 IF $DATA(APCLSPRV)
WRITE !,"Only screenings on which ",$PIECE(^VA(200,APCLSPRV,0),U)," was the primary provider",!?6,"on the visit are included"
+26 DO PAUSE
+27 QUIT
PAUSE ;
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF IO'=IO(0)
QUIT
+3 SET DIR(0)="E"
SET DIR("A")="Press return to continue or '^' to quit"
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
SET APCLQUIT=1
+5 IF $DATA(IOF)
WRITE @IOF
+6 QUIT
