- APCLAL3P ; IHS/CMI/LAB - list refusals ; 10 Dec 2009 3:10 PM
- ;;2.0;IHS PCC SUITE;**2,10,11**;MAY 14, 2009;Build 58
- ;
- ;
- PRINT ;EP - called from xbdbque
- D PRINT1
- D DONE
- Q
- PRINT1 ;
- S APCRPG=0 K APCRQUIT
- K APCRLSTP
- I '$D(^XTMP("APCLAL3",APCRJ,APCRH)) D HEADER W !!,"No data to report.",! G DONE
- D COVPAGE
- Q:$$END
- D HEADER
- S APCRTOT=APCRCNT
- S APCRPTOT=$$PTOT
- W !," Total Number of Visits with Screening",?40,$J($$COM(APCRTOT,0),8)
- W !," Total Number of Patients Screened",?40,$J($$COM(APCRPTOT,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(APCRQUIT) Q 1
- Q 0
- ENDL() ;
- I $Y<(IOSL-8) Q 0
- D HEADER
- I $D(APCRQUIT) Q 1
- Q 0
- PTOT() ;
- NEW C,X
- S C=0
- S X=0 F S X=$O(^XTMP("APCLAL3",APCRJ,APCRH,"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("APCLAL3",APCRJ,APCRH,"VSTS",X)) Q:X'=+X S C=C+1
- Q C
- G:'APCRPG 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 APCRQUIT="" Q
- W:$D(IOF) @IOF S APCRPG=APCRPG+1
- W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCRPG,!
- W !,$$CTR("*** ALCOHOL SCREENING VISIT LISTING FOR SELECTED PATIENTS ***",80),!
- S X="Screening Dates: "_$$FMTE^XLFDT(APCRBD)_" to "_$$FMTE^XLFDT(APCRED) 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("APCLAL3",APCRJ,APCRH)
- 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 APCRPG=0 K APCRQUIT
- S APCRLSTP=1
- D HEADER
- K ^TMP($J)
- ;resort by sort item
- S APCRX=0 F S APCRX=$O(^XTMP("APCLAL3",APCRJ,APCRH,"PTS",APCRX)) Q:APCRX'=+APCRX S APCRY=^XTMP("APCLAL3",APCRJ,APCRH,"PTS",APCRX) D
- .S DFN=APCRX
- .D @APCRSORT
- .I APCRSORV="" S APCRSORV="--"
- .S ^TMP($J,"PTS",APCRSORV,APCRX)=APCRY
- .Q
- S APCRSORV="" F S APCRSORV=$O(^TMP($J,"PTS",APCRSORV)) Q:APCRSORV=""!($D(APCRQUIT)) D
- .S DFN=0 F S DFN=$O(^TMP($J,"PTS",APCRSORV,DFN)) Q:DFN'=+DFN!($D(APCRQUIT)) D
- ..Q:$$ENDL
- ..S APCRY=^TMP($J,"PTS",APCRSORV,DFN)
- ..W !!,$E($P(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$P(APCRY,U,4),?33,$P(^DPT(DFN,0),U,2),?35,$$DT($P(APCRY,U,1)),?55,$E($P(APCRY,U,6),1,20)
- ..W !?3,"Type/Result: ",$P($P(APCRY,U,2),";")_" "_$P($P(APCRY,U,2),";",2)
- ..I $P(APCRY,U,12)]"" W !?3,"Comment: ",$P(APCRY,U,12)
- ..I $P(APCRY,U,20)="PCC" S APCRV=$P(APCRY,U,14) I APCRV,$D(^AUPNVPOV("AD",APCRV)) D
- ...S APCRC=0 W !?3,"DXs: "
- ...S APCRX=0 F S APCRX=$O(^AUPNVPOV("AD",APCRV,APCRX)) Q:APCRX'=+APCRX!($D(APCRQUIT)) D
- ....S APCRC=APCRC+1
- ....W:APCRC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCRX,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCRX,.04),1,60)
- ..I $P(APCRY,U,20)="BH" S APCRV=$P(APCRY,U,15) I APCRV,$D(^AMHRPRO("AD",APCRV)) D
- ...S APCRC=0 W !?3,"DXs: "
- ...S APCRX=0 F S APCRX=$O(^AMHRPRO("AD",APCRV,APCRX)) Q:APCRX'=+APCRX!($D(APCRQUIT)) D
- ....S APCRC=APCRC+1
- ....W:APCRC'=1 ! W ?8,$$VAL^XBDIQ1(9002011.01,APCRX,.01),?17,$E($$VAL^XBDIQ1(9002011.01,APCRX,.04),1,60)
- ..W !?3,"Primary Provider on Visit: ",?31,$P(APCRY,U,7)
- ..W !?3," Provider who screened: ",?31,$P(APCRY,U,5)
- Q
- H ;
- S APCRSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
- Q
- N ;
- S APCRSORV=$P(^DPT(DFN,0),U)
- Q
- P ;
- S APCRSORV=$P(APCRY,U,5)
- Q
- R ;
- S APCRSORV=$P($P(APCRY,U,2),";")_" "_$P($P(APCRY,U,2),";",2)
- Q
- D ;
- S APCRSORV=$P(APCRY,U,1)
- Q
- A S APCRSORV=$P(APCRY,U,4)
- Q
- G ;
- S APCRSORV=$P(APCRY,U,3)
- Q
- C ;
- S APCRSORV=$P(APCRY,U,6)
- Q
- T ;
- S %=$$HRN^AUPNPAT(DFN,DUZ(2))
- S %=%+10000000,%=$E(%,7,8)_"-"_+$E(%,2,8)
- S APCRSORV=%
- 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("********** ALCOHOL SCREENING FOR SELECTED PATIENTS **********",80)
- W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
- W !!,"The following report contains an ALCOHOL screening report based on the",!,"following criteria:"
- SHOW ;
- W !!?6,"Patient must have had a screening between ",$$FMTE^XLFDT(APCRBD)," and ",$$FMTE^XLFDT(APCRED),!
- ;W:APCRTYPE="S" !!?6,"Search Template: ",$P(^DIBT(APCRSEAT,0),U),!
- W !?6,"Gender: ",$S(APCRSEX="F":"FEMALES ONLY",APCRSEX="M":"MALES ONLY",APCRSEX="U":"UNKNOWN",APCRSEX="MFU":"ALL GENDERS",1:"")
- I $D(APCRAGET) W !?6,"Age of Patients included: ",$P(APCRAGET,"-")," to ",$P(APCRAGET,"-",2)
- I '$D(APCRAGET) 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(APCRREST(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(APCRCLNT) W !,"Screenings done in the following clinics are included:" D
- .S X=0 F S X=$O(APCRCLNT(X)) Q:X'=+X W !?10,$P(^DIC(40.7,X,0),U)," ("_$P(^DIC(40.7,X,0),U,2)_")"
- I '$D(APCRCLNT),APCLEXBH W !,"Screenings done in ALL clinics included"
- I 'APCLEXBH W !,"Behavioral Health Clinics excluded."
- I APCRDESP]"" W !,"Only patients whose Designated Mental Health Provider",!?6,$P(^VA(200,APCRDESP,0),U)," are included"
- I APCRSSP]"" W !,"Only patients whose Designated Social Services Provider",!?6,$P(^VA(200,APCRSSP,0),U)," are included"
- I APCRCDP]"" W !,"Only patients whose Designated ASA/CD Provider",!?6,$P(^VA(200,APCRCDP,0),U)," are included"
- I APCRPPUN 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 APCRSPUN 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(APCRPROV) W !,"Visits to any Primary Provider are included"
- I '$D(APCRSPRV) W !,"Visits on which any provider did the screening are included"
- I $D(APCRPROV) W !,"Only screenings on which ",$P(^VA(200,APCRPROV,0),U)," was the primary provider",!?6,"on the visit are included"
- I $D(APCRSPRV) W !,"Only screenings on which ",$P(^VA(200,APCRSPRV,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) APCRQUIT=1
- W:$D(IOF) @IOF
- Q
- APCLAL3P ; IHS/CMI/LAB - list refusals ; 10 Dec 2009 3:10 PM
- +1 ;;2.0;IHS PCC SUITE;**2,10,11**;MAY 14, 2009;Build 58
- +2 ;
- +3 ;
- PRINT ;EP - called from xbdbque
- +1 DO PRINT1
- +2 DO DONE
- +3 QUIT
- PRINT1 ;
- +1 SET APCRPG=0
- KILL APCRQUIT
- +2 KILL APCRLSTP
- +3 IF '$DATA(^XTMP("APCLAL3",APCRJ,APCRH))
- DO HEADER
- WRITE !!,"No data to report.",!
- GOTO DONE
- +4 DO COVPAGE
- +5 IF $$END
- QUIT
- +6 DO HEADER
- +7 SET APCRTOT=APCRCNT
- +8 SET APCRPTOT=$$PTOT
- +9 WRITE !," Total Number of Visits with Screening",?40,$JUSTIFY($$COM(APCRTOT,0),8)
- +10 WRITE !," Total Number of Patients Screened",?40,$JUSTIFY($$COM(APCRPTOT,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(APCRQUIT)
- QUIT 1
- +4 QUIT 0
- ENDL() ;
- +1 IF $Y<(IOSL-8)
- QUIT 0
- +2 DO HEADER
- +3 IF $DATA(APCRQUIT)
- QUIT 1
- +4 QUIT 0
- PTOT() ;
- +1 NEW C,X
- +2 SET C=0
- +3 SET X=0
- FOR
- SET X=$ORDER(^XTMP("APCLAL3",APCRJ,APCRH,"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("APCLAL3",APCRJ,APCRH,"VSTS",X))
- IF X'=+X
- QUIT
- SET C=C+1
- +4 QUIT C
- +1 IF 'APCRPG
- 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 APCRQUIT=""
- QUIT
- +1 IF $DATA(IOF)
- WRITE @IOF
- SET APCRPG=APCRPG+1
- +2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCRPG,!
- +3 WRITE !,$$CTR("*** ALCOHOL SCREENING VISIT LISTING FOR SELECTED PATIENTS ***",80),!
- +4 SET X="Screening Dates: "_$$FMTE^XLFDT(APCRBD)_" to "_$$FMTE^XLFDT(APCRED)
- 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("APCLAL3",APCRJ,APCRH)
- +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 APCRPG=0
- KILL APCRQUIT
- +2 SET APCRLSTP=1
- +3 DO HEADER
- +4 KILL ^TMP($JOB)
- +5 ;resort by sort item
- +6 SET APCRX=0
- FOR
- SET APCRX=$ORDER(^XTMP("APCLAL3",APCRJ,APCRH,"PTS",APCRX))
- IF APCRX'=+APCRX
- QUIT
- SET APCRY=^XTMP("APCLAL3",APCRJ,APCRH,"PTS",APCRX)
- Begin DoDot:1
- +7 SET DFN=APCRX
- +8 DO @APCRSORT
- +9 IF APCRSORV=""
- SET APCRSORV="--"
- +10 SET ^TMP($JOB,"PTS",APCRSORV,APCRX)=APCRY
- +11 QUIT
- End DoDot:1
- +12 SET APCRSORV=""
- FOR
- SET APCRSORV=$ORDER(^TMP($JOB,"PTS",APCRSORV))
- IF APCRSORV=""!($DATA(APCRQUIT))
- QUIT
- Begin DoDot:1
- +13 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,"PTS",APCRSORV,DFN))
- IF DFN'=+DFN!($DATA(APCRQUIT))
- QUIT
- Begin DoDot:2
- +14 IF $$ENDL
- QUIT
- +15 SET APCRY=^TMP($JOB,"PTS",APCRSORV,DFN)
- +16 WRITE !!,$EXTRACT($PIECE(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$PIECE(APCRY,U,4),?33,$PIECE(^DPT(DFN,0),U,2),?35,$$DT($PIECE(APCRY,U,1)),?55,$EXTRACT($PIECE(APCRY,U,6),1,20)
- +17 WRITE !?3,"Type/Result: ",$PIECE($PIECE(APCRY,U,2),";")_" "_$PIECE($PIECE(APCRY,U,2),";",2)
- +18 IF $PIECE(APCRY,U,12)]""
- WRITE !?3,"Comment: ",$PIECE(APCRY,U,12)
- +19 IF $PIECE(APCRY,U,20)="PCC"
- SET APCRV=$PIECE(APCRY,U,14)
- IF APCRV
- IF $DATA(^AUPNVPOV("AD",APCRV))
- Begin DoDot:3
- +20 SET APCRC=0
- WRITE !?3,"DXs: "
- +21 SET APCRX=0
- FOR
- SET APCRX=$ORDER(^AUPNVPOV("AD",APCRV,APCRX))
- IF APCRX'=+APCRX!($DATA(APCRQUIT))
- QUIT
- Begin DoDot:4
- +22 SET APCRC=APCRC+1
- +23 IF APCRC'=1
- WRITE !
- WRITE ?8,$$VAL^XBDIQ1(9000010.07,APCRX,.01),?17,$EXTRACT($$VAL^XBDIQ1(9000010.07,APCRX,.04),1,60)
- End DoDot:4
- End DoDot:3
- +24 IF $PIECE(APCRY,U,20)="BH"
- SET APCRV=$PIECE(APCRY,U,15)
- IF APCRV
- IF $DATA(^AMHRPRO("AD",APCRV))
- Begin DoDot:3
- +25 SET APCRC=0
- WRITE !?3,"DXs: "
- +26 SET APCRX=0
- FOR
- SET APCRX=$ORDER(^AMHRPRO("AD",APCRV,APCRX))
- IF APCRX'=+APCRX!($DATA(APCRQUIT))
- QUIT
- Begin DoDot:4
- +27 SET APCRC=APCRC+1
- +28 IF APCRC'=1
- WRITE !
- WRITE ?8,$$VAL^XBDIQ1(9002011.01,APCRX,.01),?17,$EXTRACT($$VAL^XBDIQ1(9002011.01,APCRX,.04),1,60)
- End DoDot:4
- End DoDot:3
- +29 WRITE !?3,"Primary Provider on Visit: ",?31,$PIECE(APCRY,U,7)
- +30 WRITE !?3," Provider who screened: ",?31,$PIECE(APCRY,U,5)
- End DoDot:2
- End DoDot:1
- +31 QUIT
- H ;
- +1 SET APCRSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
- +2 QUIT
- N ;
- +1 SET APCRSORV=$PIECE(^DPT(DFN,0),U)
- +2 QUIT
- P ;
- +1 SET APCRSORV=$PIECE(APCRY,U,5)
- +2 QUIT
- R ;
- +1 SET APCRSORV=$PIECE($PIECE(APCRY,U,2),";")_" "_$PIECE($PIECE(APCRY,U,2),";",2)
- +2 QUIT
- D ;
- +1 SET APCRSORV=$PIECE(APCRY,U,1)
- +2 QUIT
- A SET APCRSORV=$PIECE(APCRY,U,4)
- +1 QUIT
- G ;
- +1 SET APCRSORV=$PIECE(APCRY,U,3)
- +2 QUIT
- C ;
- +1 SET APCRSORV=$PIECE(APCRY,U,6)
- +2 QUIT
- T ;
- +1 SET %=$$HRN^AUPNPAT(DFN,DUZ(2))
- +2 SET %=%+10000000
- SET %=$EXTRACT(%,7,8)_"-"_+$EXTRACT(%,2,8)
- +3 SET APCRSORV=%
- +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("********** ALCOHOL SCREENING FOR SELECTED PATIENTS **********",80)
- +3 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
- +4 WRITE !!,"The following report contains an ALCOHOL screening report based on the",!,"following criteria:"
- SHOW ;
- +1 WRITE !!?6,"Patient must have had a screening between ",$$FMTE^XLFDT(APCRBD)," and ",$$FMTE^XLFDT(APCRED),!
- +2 ;W:APCRTYPE="S" !!?6,"Search Template: ",$P(^DIBT(APCRSEAT,0),U),!
- +3 WRITE !?6,"Gender: ",$SELECT(APCRSEX="F":"FEMALES ONLY",APCRSEX="M":"MALES ONLY",APCRSEX="U":"UNKNOWN",APCRSEX="MFU":"ALL GENDERS",1:"")
- +4 IF $DATA(APCRAGET)
- WRITE !?6,"Age of Patients included: ",$PIECE(APCRAGET,"-")," to ",$PIECE(APCRAGET,"-",2)
- +5 IF '$DATA(APCRAGET)
- 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(APCRREST(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(APCRCLNT)
- WRITE !,"Screenings done in the following clinics are included:"
- Begin DoDot:1
- +14 SET X=0
- FOR
- SET X=$ORDER(APCRCLNT(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(APCRCLNT)
- IF APCLEXBH
- WRITE !,"Screenings done in ALL clinics included"
- +16 IF 'APCLEXBH
- WRITE !,"Behavioral Health Clinics excluded."
- +17 IF APCRDESP]""
- WRITE !,"Only patients whose Designated Mental Health Provider",!?6,$PIECE(^VA(200,APCRDESP,0),U)," are included"
- +18 IF APCRSSP]""
- WRITE !,"Only patients whose Designated Social Services Provider",!?6,$PIECE(^VA(200,APCRSSP,0),U)," are included"
- +19 IF APCRCDP]""
- WRITE !,"Only patients whose Designated ASA/CD Provider",!?6,$PIECE(^VA(200,APCRCDP,0),U)," are included"
- +20 IF APCRPPUN
- 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 APCRSPUN
- 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(APCRPROV)
- WRITE !,"Visits to any Primary Provider are included"
- +23 IF '$DATA(APCRSPRV)
- WRITE !,"Visits on which any provider did the screening are included"
- +24 IF $DATA(APCRPROV)
- WRITE !,"Only screenings on which ",$PIECE(^VA(200,APCRPROV,0),U)," was the primary provider",!?6,"on the visit are included"
- +25 IF $DATA(APCRSPRV)
- WRITE !,"Only screenings on which ",$PIECE(^VA(200,APCRSPRV,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 APCRQUIT=1
- +5 IF $DATA(IOF)
- WRITE @IOF
- +6 QUIT