Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLDV5P

APCLDV5P.m

Go to the documentation of this file.
APCLDV5P ; IHS/CMI/LAB - list refusals ;
 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
 ;
 ;
PRINT ;EP - called from xbdbque
 D PRINT1
 D DONE
 Q
PRINT1 ;
 S APCLPG=0 K APCLQUIT
 K APCLLSTP S APCLTALP=0
 I '$D(^XTMP("APCLDV5",APCLJ,APCLH)) D HEADER W !!,"No data to report.",! G DONE
 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)
 S X=0,C=0 F  S X=$O(^DIBT(APCLSEAT,1,X)) Q:X'=+X  S C=C+1
 W !,"  Total Number of Patients in Template",?40,$J($$COM(C,0),8)
 S APCLTALP=1
 W !!?46,"#",?53,"% of patients screened"
 D RES
 Q:$$END
 D GENDER
 Q:$$END
 D AGE
 Q:$$END
 D PRVSC
 Q:$$END
 D PRVV
 Q:$$END
 D DESPRV
 Q:$$END
 D CLINIC
 Q:$$END
 D DATE
 Q:$$END
 K ^TMP($J)
 I APCLLIST D LIST
 Q
RES ;
 Q:'$D(APCLTALL(1))
 ;TALLY BY RESULT FIRST
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,3) S:R="" R="NO RESULT RECORDED" S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"                              By Result",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .S Y=$L(APCLX),Y=38-Y W !?Y,APCLX,?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 Q
GENDER ;
 Q:'$D(APCLTALL(2))
 ;TALLY BY GENDER OF PATIENT
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,6) S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"                              By Gender",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L(APCLX),Y=38-Y W !?Y,APCLX,?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 .Q
 Q
AGE ;
 Q:'$D(APCLTALL(3))
 ;TALLY BY age OF PATIENT
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,5) S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"                                By Age",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L(APCLX_" yrs"),Y=38-Y W !?Y,APCLX," yrs",?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 Q
PRVSC ;
 Q:'$D(APCLTALL(4))
 ;TALLY BY PRIMARY provider OF service
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,16) S:R="" R="UNKNOWN" S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"              By Provider who screened",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L(APCLX),Y=38-Y W !?Y,APCLX,?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 Q
PRVV ;
 Q:'$D(APCLTALL(5))
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,2) S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"           By Primary Provider of Visit",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L(APCLX),Y=38-Y W !?Y,APCLX,?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 Q
DESPRV ;
 Q:'$D(APCLTALL(6))
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,17) S:R="" R="UNKNOWN" S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"     By Designated Primary Care Provider",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L(APCLX),Y=38-Y W !?Y,APCLX,?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 Q
CLINIC ;
 Q:'$D(APCLTALL(7))
 ;TALLY BY clinic
 K APCLRES S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,10) S:R="" R="UNKNOWN" S APCLRES(R)=$G(APCLRES(R))+1
 W !
 W !,"                              By Clinic",!
 S APCLX="" F  S APCLX=$O(APCLRES(APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L(APCLX),Y=38-Y W !?Y,APCLX,?40,$J($$COM($G(APCLRES(APCLX)),0),8),?55,$$PER(APCLRES(APCLX),APCLTOT) K APCLRES(APCLX)
 Q
DATE ;
 Q:'$D(APCLTALL(8))
 ;TALLY BY date OF service
 K ^TMP($J) S X=0 F  S X=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  D
 .S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",X)
 .S R=$P(APCLY,U,7) S ^TMP($J,R)=$G(^TMP($J,R))+1
 W !
 W !,"                               By Date",!
 S APCLX="" F  S APCLX=$O(^TMP($J,APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
 .Q:$$END
 .S Y=$L($$FMTE^XLFDT(APCLX)),Y=38-Y W !?Y,$$FMTE^XLFDT(APCLX),?40,$J($$COM($G(^TMP($J,APCLX)),0),8),?55,$$PER(^TMP($J,APCLX),APCLTOT) K ^TMP($J,APCLX)
 Q
 ;
PER(N,D) ;return % of n/d
 I 'D Q "0%"
 NEW Z
 S Z=N/D,Z=Z*100,Z=$J(Z,5,1)
 Q $$STRIP^XLFSTR(Z," ")_"%"
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("APCLDV5",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("APCLDV5",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
HEADER1 ;
 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("***  IPV SCREENING VISIT TALLY"_$S(APCLLIST:" AND VISIT LISTING",1:"")_"  ***",80),!
 S X="Screening Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
 I APCLEXBH S X="This report includes Behavioral Health Clinics" W $$CTR(X,80),!
 I 'APCLEXBH S X="This report excludes Behavioral Health Clinics" W $$CTR(X,80),!
 D LOCHDR^APCLDV1P,COMMHDR^APCLDV1P
 S X="SEARCH TEMPLATE OF PATIENTS: "_$P(^DIBT(APCLSEAT,0),U) W $$CTR(X,80),!
 I $G(APCLLSTP),APCLSCRD S X="Listing of those patients screened" W $$CTR(X,80),!
 I $G(APCLLSTP),'APCLSCRD S X="Listing of those NOT Screened" W $$CTR(X,80),!
 I $G(APCLLSTP) W !?35,"DATE",!,"PATIENT NAME",?22,"HRN",?29,"AGE",?35,"SCREENED",?44,"RESULT",?61,"CLINIC"
 W !,$TR($J("",80)," ","-")
 I '$G(APCLLSTP) W !?46,"#",?53,"% of patients",$S(APCLTALP:" screened",1:"")
 Q
DONE ;
 K ^TMP($J)
 K ^XTMP("APCLDV5",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,APCLSCRD=1
 D HEADER
 K ^TMP($J)
 ;resort by sort item
 S APCLX=0 F  S APCLX=$O(^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",APCLX)) Q:APCLX'=+APCLX  S APCLY=^XTMP("APCLDV5",APCLJ,APCLH,"VSTS",APCLX) D
 .S DFN=$P(APCLY,U,9)
 .D @APCLSORT
 .I APCLSORV="" S APCLSORV="--"
 .S ^TMP($J,"VSTS",APCLSORV,APCLX)=APCLY
 .Q
 S APCLSORV="" F  S APCLSORV=$O(^TMP($J,"VSTS",APCLSORV)) Q:APCLSORV=""!($D(APCLQUIT))  D
 .S APCLX=0 F  S APCLX=$O(^TMP($J,"VSTS",APCLSORV,APCLX)) Q:APCLX'=+APCLX!($D(APCLQUIT))  D
 ..Q:$$ENDL
 ..S APCLY=^TMP($J,"VSTS",APCLSORV,APCLX),DFN=$P(APCLY,U,9)
 ..W !,$E($P(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$P(APCLY,U,5),?33,$P(^DPT(DFN,0),U,2),?35,$$DT($P(APCLY,U,7)),?44,$E($P(APCLY,U,3),1,16),?61,$E($P(APCLY,U,10),1,17)
 ..I $P(APCLY,U,4)]"" W !?3,"Comment: ",$P(APCLY,U,4)
 ..I $P(APCLY,U,1)="EX" S APCLV=$P(APCLY,U,15) I $D(^AUPNVPOV("AD",APCLV)) D
 ...S APCLC=0 W !?3,"DXs: "
 ...S APCLS=0 F  S APCLS=$O(^AUPNVPOV("AD",APCLV,APCLS)) Q:APCLS'=+APCLS!($D(APCLQUIT))  D
 ....S APCLC=APCLC+1
 ....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCLS,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCLS,.04),1,60)
 ..I $P(APCLY,U,1)="BH" S APCLV=$P(APCLY,U,15) I $D(^AMHRPRO("AD",APCLV)) D
 ...S APCLC=0 W !?3,"DXs: "
 ...S APCLS=0 F  S APCLS=$O(^AMHRPRO("AD",APCLV,APCLS)) Q:APCLS'=+APCLS!($D(APCLQUIT))  D
 ....S APCLC=APCLC+1
 ....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9002011.01,APCLS,.01),?17,$E($$VAL^XBDIQ1(9002011.01,APCLS,.04),1,60)
 ..I $P(APCLY,U,1)="REF" S APCLD=$P(APCLY,U,7)  D
 ...K APCLV S A="APCLV(",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCLD)_"-"_$$FMTE^XLFDT(APCLD),E=$$START1^APCLDF(B,A)
 ...I $D(APCLV) S APCLV1=0 F  S APCLV1=$O(APCLV(APCLV1)) Q:APCLV1'=+APCLV1  S APCLV=$P(APCLV(APCLV1),U,5) D
 ....S APCLC=0 W !?3,"DXs: "
 ....S APCLS=0 F  S APCLS=$O(^AUPNVPOV("AD",APCLV,APCLS)) Q:APCLS'=+APCLS!($D(APCLQUIT))  D
 .....S APCLC=APCLC+1
 .....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCLS,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCLS,.04),1,60)
 ..W !?3,"Primary Provider on Visit: ",?31,$P(APCLY,U,2)
 ..W !?3,"     Primary who screened: ",?31,$P(APCLY,U,16)
 S APCLSCRD=0
 D HEADER
 S DFN=0 F  S DFN=$O(^DIBT(APCLSEAT,1,DFN)) Q:DFN'=+DFN!($D(APCLQUIT))  D
 .Q:$D(^XTMP("APCLDV5",APCLJ,APCLH,"PTS",DFN))
 .Q:$$END
 .W !,$E($P(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$$AGE^AUPNPAT(DFN,DT),?33,$P(^DPT(DFN,0),U,2)
 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,2)
 Q
R ;
 S APCLSORV=$P(APCLY,U,3)
 Q
D ;
 S APCLSORV=$P(APCLY,U,7)
 Q
A S APCLSORV=$P(APCLY,U,5)
 Q
G ;
 S APCLSORV=$P(APCLY,U,6)
 Q
C ;
 S APCLSORV=$P(APCLY,U,9)
 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)
 ;