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

APCLAL5P.m

Go to the documentation of this file. 
  1. APCLAL5P ; IHS/CMI/LAB - list refusals ; 
  1.  ;;2.0;IHS PCC SUITE;**2,8,11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  D PRINT1
  1.  D DONE
  1.  Q
  1. PRINT1 ;
  1.  S APCRPG=0 K APCRQUIT
  1.  K APCRLSTP S APCRTALP=0
  1.  I '$D(^XTMP("APCLAL5",APCRJ,APCRH)) D HEADER W !!,"No data to report.",! G DONE
  1.  D HEADER
  1.  S APCRTOT=APCRCNT
  1.  S APCRPTOT=$$PTOT
  1.  W !," Total Number of Visits with Screening",?40,$J($$COM(APCRTOT,0),8)
  1.  W !,"     Total Number of Patients screened",?40,$J($$COM(APCRPTOT,0),8)
  1.  S X=0,C=0 F  S X=$O(^DIBT(APCRSEAT,1,X)) Q:X'=+X  S C=C+1
  1.  W !,"  Total Number of Patients in Template",?40,$J($$COM(C,0),8)
  1.  S APCRTALP=1
  1.  W !!?46,"#",?53,"% of patients screened"
  1.  D RES
  1.  Q:$$END
  1.  D GENDER
  1.  Q:$$END
  1.  D AGE
  1.  Q:$$END
  1.  D PRVSC
  1.  Q:$$END
  1.  D PRVV
  1.  Q:$$END
  1.  D DESPRV
  1.  Q:$$END
  1.  D CLINIC
  1.  Q:$$END
  1.  D DATE
  1.  Q:$$END
  1.  D MH
  1.  Q:$$END
  1.  D SS
  1.  Q:$$END
  1.  D CD
  1.  Q:$$END
  1.  K ^TMP($J)
  1.  I APCRLIST D LIST
  1.  Q
  1. RES ;
  1.  Q:'$D(APCRTALL(1))
  1.  ;TALLY BY RESULT FIRST
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,2) S R=$P(R,";")_"  "_$P(R,";",2) S:R="" R="NO RESULT RECORDED" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"                              By Result",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. GENDER ;
  1.  Q:'$D(APCRTALL(2))
  1.  ;TALLY BY GENDER OF PATIENT1
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,3) S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"                              By Gender",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  .Q
  1.  Q
  1. AGE ;
  1.  Q:'$D(APCRTALL(3))
  1.  ;TALLY BY age OF PATIENT
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,4) S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"                                By Age",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX_" yrs"),Y=38-Y W !?Y,APCRX," yrs",?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. PRVSC ;
  1.  Q:'$D(APCRTALL(4))
  1.  ;TALLY BY PRIMARY provider OF service
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,5) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"              By Provider who screened",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. PRVV ;
  1.  Q:'$D(APCRTALL(7))
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,7) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"           By Primary Provider of Visit",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. DESPRV ;
  1.  Q:'$D(APCRTALL(11))
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,11) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"     By Designated Primary Care Provider",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. MH ;
  1.  Q:'$D(APCRTALL(8))
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,8) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"     By Designated Mental Health Provider",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. SS ;
  1.  Q:'$D(APCRTALL(9))
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,9) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"    By Designated Social Services Provider",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. CD ;
  1.  Q:'$D(APCRTALL(10))
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,10) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"     By Designated A/SA Provider",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. CLINIC ;
  1.  Q:'$D(APCRTALL(5))
  1.  ;TALLY BY clinic
  1.  K APCRRES S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,6) S:R="" R="UNKNOWN" S APCRRES(R)=$G(APCRRES(R))+1
  1.  W !
  1.  W !,"                              By Clinic",!
  1.  S APCRX="" F  S APCRX=$O(APCRRES(APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L(APCRX),Y=38-Y W !?Y,APCRX,?40,$J($$COM($G(APCRRES(APCRX)),0),8),?55,$$PER(APCRRES(APCRX),APCRTOT) K APCRRES(APCRX)
  1.  Q
  1. DATE ;
  1.  Q:'$D(APCRTALL(6))
  1.  ;TALLY BY date OF service
  1.  K ^TMP($J) S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  D
  1.  .S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)
  1.  .S R=$P(APCRY,U,1) S ^TMP($J,R)=$G(^TMP($J,R))+1
  1.  W !
  1.  W !,"                               By Date",!
  1.  S APCRX="" F  S APCRX=$O(^TMP($J,APCRX)) Q:APCRX=""!($D(APCRQUIT))  D
  1.  .Q:$$END
  1.  .S Y=$L($$FMTE^XLFDT(APCRX)),Y=38-Y W !?Y,$$FMTE^XLFDT(APCRX),?40,$J($$COM($G(^TMP($J,APCRX)),0),8),?55,$$PER(^TMP($J,APCRX),APCRTOT) K ^TMP($J,APCRX)
  1.  Q
  1.  ;
  1. PER(N,D) ;return % of n/d
  1.  I 'D Q "0%"
  1.  NEW Z
  1.  S Z=N/D,Z=Z*100,Z=$J(Z,5,1)
  1.  Q $$STRIP^XLFSTR(Z," ")_"%"
  1. COM(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q $$STRIP^XLFSTR(X," ")
  1. END() ;
  1.  I $Y<(IOSL-3) Q 0
  1.  D HEADER
  1.  I $D(APCRQUIT) Q 1
  1.  Q 0
  1. ENDL() ;
  1.  I $Y<(IOSL-8) Q 0
  1.  D HEADER
  1.  I $D(APCRQUIT) Q 1
  1.  Q 0
  1. PTOT() ;
  1.  NEW C,X
  1.  S C=0
  1.  S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"PTS",X)) Q:X'=+X  S C=C+1
  1.  Q C
  1. TOT() ;
  1.  NEW C,X
  1.  S C=0
  1.  S X=0 F  S X=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",X)) Q:X'=+X  S C=C+1
  1.  Q C
  1.  G:'APCRPG HEADER1
  1.  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
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S APCRPG=APCRPG+1
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCRPG,!
  1.  W !,$$CTR("***  ALCOHOL SCREENING VISIT TALLY"_$S(APCRLIST:" AND VISIT LISTING",1:"")_"  ***",80),!
  1.  S X="Screening Dates: "_$$FMTE^XLFDT(APCRBD)_" to "_$$FMTE^XLFDT(APCRED) W $$CTR(X,80),!
  1.  I APCLEXBH S X="This report includes data from the Behavioral Health Clinics" W $$CTR(X,80),!
  1.  I 'APCLEXBH S X="This report excludes data from the Behavioral Health Clinics" W $$CTR(X,80),!
  1.  S X="SEARCH TEMPLATE OF PATIENTS: "_$P(^DIBT(APCRSEAT,0),U) W $$CTR(X,80),!
  1.  I $G(APCRLSTP),APCRSCRD S X="Listing of those patients screened" W $$CTR(X,80),!
  1.  I $G(APCRLSTP),'APCRSCRD S X="Listing of those NOT Screened" W $$CTR(X,80),!
  1.  I $G(APCRLSTP) W !?35,"DATE",!,"PATIENT NAME",?22,"HRN",?29,"AGE",?35,"SCREENED",?55,"CLINIC"
  1.  W !,$TR($J("",80)," ","-")
  1.  I '$G(APCRLSTP) W !?46,"#",?53,"% of patients",$S(APCRTALP:" screened",1:"")
  1.  Q
  1. DONE ;
  1.  K ^TMP($J)
  1.  K ^XTMP("APCLAL5",APCRJ,APCRH)
  1.  D EOP
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:IO'=IO(0)
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  W !
  1.  S DIR("A")="End of Report.  Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. LIST ;EP - called from xbdbque
  1.  S APCRPG=0 K APCRQUIT
  1.  S APCRLSTP=1,APCRSCRD=1
  1.  D HEADER
  1.  K ^TMP($J)
  1.  ;resort by sort item
  1.  S APCRX=0 F  S APCRX=$O(^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",APCRX)) Q:APCRX'=+APCRX  S APCRY=^XTMP("APCLAL5",APCRJ,APCRH,"VSTS",APCRX) D
  1.  .S DFN=$P(APCRY,U,15)
  1.  .D @APCRSORT
  1.  .I APCRSORV="" S APCRSORV="--"
  1.  .S ^TMP($J,"VSTS",APCRSORV,APCRX)=APCRY
  1.  .Q
  1.  S APCRSORV="" F  S APCRSORV=$O(^TMP($J,"VSTS",APCRSORV)) Q:APCRSORV=""!($D(APCRQUIT))  D
  1.  .S APCRZ=0 F  S APCRZ=$O(^TMP($J,"VSTS",APCRSORV,APCRZ)) Q:APCRZ'=+APCRZ!($D(APCRQUIT))  D
  1.  ..Q:$$ENDL
  1.  ..S APCRY=^TMP($J,"VSTS",APCRSORV,APCRZ),DFN=$P(APCRY,U,15)
  1.  ..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)
  1.  ..W !?3,"Type/Result: ",$P($P(APCRY,U,2),";")_"  "_$P($P(APCRY,U,2),";",2)
  1.  ..I $P(APCRY,U,12)]"" W !?3,"Comment: ",$P(APCRY,U,12)
  1.  ..I $P(APCRY,U,20)="PCC" S APCRV=$P(APCRY,U,14) I APCRV,$D(^AUPNVPOV("AD",APCRV)) D
  1.  ...S APCRC=0 W !?3,"DXs: "
  1.  ...S APCRX=0 F  S APCRX=$O(^AUPNVPOV("AD",APCRV,APCRX)) Q:APCRX'=+APCRX!($D(APCRQUIT))  D
  1.  ....S APCRC=APCRC+1
  1.  ....W:APCRC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCRX,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCRX,.04),1,60)
  1.  ..I $P(APCRY,U,20)="BH" S APCRV=$P(APCRY,U,15) I APCRV,$D(^AMHRPRO("AD",APCRV)) D
  1.  ...S APCRC=0 W !?3,"DXs: "
  1.  ...S APCRX=0 F  S APCRX=$O(^AMHRPRO("AD",APCRV,APCRX)) Q:APCRX'=+APCRX!($D(APCRQUIT))  D
  1.  ....S APCRC=APCRC+1
  1.  ....W:APCRC'=1 ! W ?8,$$VAL^XBDIQ1(9002011.01,APCRX,.01),?17,$E($$VAL^XBDIQ1(9002011.01,APCRX,.04),1,60)
  1.  ..W !?3,"Primary Provider on Visit: ",?31,$P(APCRY,U,7)
  1.  ..W !?3,"    Provider who screened: ",?31,$P(APCRY,U,5)
  1.  S APCRSCRD=0
  1.  D HEADER
  1.  S DFN=0 F  S DFN=$O(^DIBT(APCRSEAT,1,DFN)) Q:DFN'=+DFN!($D(APCRQUIT))  D
  1.  .Q:$D(^XTMP("APCLAL5",APCRJ,APCRH,"PTS",DFN))
  1.  .Q:$$END
  1.  .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)
  1.  Q
  1. H ;
  1.  S APCRSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
  1.  Q
  1. N ;
  1.  S APCRSORV=$P(^DPT(DFN,0),U)
  1.  Q
  1. P ;
  1.  S APCRSORV=$P(APCRY,U,5)
  1.  Q
  1. R ;
  1.  S APCRSORV=$P($P(APCRY,U,2),";")_"  "_$P($P(APCRY,U,2),";",2)
  1.  Q
  1. D ;
  1.  S APCRSORV=$P(APCRY,U,1)
  1.  Q
  1. A S APCRSORV=$P(APCRY,U,4)
  1.  Q
  1. G ;
  1.  S APCRSORV=$P(APCRY,U,3)
  1.  Q
  1. C ;
  1.  S APCRSORV=$P(APCRY,U,6)
  1.  Q
  1. T ;
  1.  S %=$$HRN^AUPNPAT(DFN,DUZ(2))
  1.  S %=%+10000000,%=$E(%,7,8)_"-"_+$E(%,2,8)
  1.  S APCRSORV=%
  1.  Q
  1. DT(D) ;EP
  1.  I D="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  1.  ;