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

APCLDV3P.m

Go to the documentation of this file. 
  1. APCLDV3P ; IHS/CMI/LAB - list refusals ;
  1.  ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
  1.  ;
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  D PRINT1
  1.  D DONE
  1.  Q
  1. PRINT1 ;
  1.  S APCLPG=0 K APCLQUIT
  1.  K APCLLSTP
  1.  I '$D(^XTMP("APCLDV3",APCLJ,APCLH)) D HEADER W !!,"No data to report.",! G DONE
  1.  D COVPAGE
  1.  Q:$$END
  1.  D HEADER
  1.  S APCLTOT=APCLCNT
  1.  S APCLPTOT=$$PTOT
  1.  W !," Total Number of Visits with Screening",?40,$J($$COM(APCLTOT,0),8)
  1.  W !,"     Total Number of Patients Screened",?40,$J($$COM(APCLPTOT,0),8)
  1.  I APCLTMPL="L" D LIST Q
  1.  ;store search template
  1.  S X=0 F  S X=$O(^XTMP("APCLDV3",APCLJ,APCLH,"PTS",X)) Q:X'=+X  S ^DIBT(APCLSTMP,1,X)=""
  1.  W !!,"Search template ",$P(^DIBT(APCLSTMP,0),U)," has been created.",!
  1.  Q
  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(APCLQUIT) Q 1
  1.  Q 0
  1. ENDL() ;
  1.  I $Y<(IOSL-8) Q 0
  1.  D HEADER
  1.  I $D(APCLQUIT) Q 1
  1.  Q 0
  1. PTOT() ;
  1.  NEW C,X
  1.  S C=0
  1.  S X=0 F  S X=$O(^XTMP("APCLDV3",APCLJ,APCLH,"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("APCLDV3",APCLJ,APCLH,"VSTS",X)) Q:X'=+X  S C=C+1
  1.  Q C
  1.  G:'APCLPG 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 APCLQUIT="" Q
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
  1.  W !,$$CTR("***  IPV SCREENING VISIT LISTING FOR SELECTED PATIENTS  ***",80),!
  1.  D LOCHDR^APCLDV1P,COMMHDR^APCLDV1P
  1.  S X="Screening Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
  1.  W !?35,"DATE",!,"PATIENT NAME",?22,"HRN",?29,"AGE",?35,"SCREENED",?44,"RESULT",?61,"CLINIC"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. DONE ;
  1.  K ^TMP($J)
  1.  K ^XTMP("APCLDV3",APCLJ,APCLH)
  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 APCLPG=0 K APCLQUIT
  1.  S APCLLSTP=1
  1.  D HEADER
  1.  K ^TMP($J)
  1.  ;resort by sort item
  1.  S APCLX=0 F  S APCLX=$O(^XTMP("APCLDV3",APCLJ,APCLH,"VSTS",APCLX)) Q:APCLX'=+APCLX  S APCLY=^XTMP("APCLDV3",APCLJ,APCLH,"VSTS",APCLX) D
  1.  .S DFN=$P(APCLY,U,9)
  1.  .D @APCLSORT
  1.  .I APCLSORV="" S APCLSORV="--"
  1.  .S ^TMP($J,"VSTS",APCLSORV,APCLX)=APCLY
  1.  .Q
  1.  S APCLSORV="" F  S APCLSORV=$O(^TMP($J,"VSTS",APCLSORV)) Q:APCLSORV=""!($D(APCLQUIT))  D
  1.  .S APCLX=0 F  S APCLX=$O(^TMP($J,"VSTS",APCLSORV,APCLX)) Q:APCLX'=+APCLX!($D(APCLQUIT))  D
  1.  ..Q:$$ENDL
  1.  ..S APCLY=^TMP($J,"VSTS",APCLSORV,APCLX),DFN=$P(APCLY,U,9)
  1.  ..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)
  1.  ..I $P(APCLY,U,4)]"" W !?3,"Comment: ",$P(APCLY,U,4)
  1.  ..I $P(APCLY,U,1)="EX" S APCLV=$P(APCLY,U,15) I $D(^AUPNVPOV("AD",APCLV)) D
  1.  ...S APCLC=0 W !?3,"DXs: "
  1.  ...S APCLS=0 F  S APCLS=$O(^AUPNVPOV("AD",APCLV,APCLS)) Q:APCLS'=+APCLS!($D(APCLQUIT))  D
  1.  ....S APCLC=APCLC+1
  1.  ....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCLS,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCLS,.04),1,60)
  1.  ..I $P(APCLY,U,1)="BH" S APCLV=$P(APCLY,U,15) I $D(^AMHRPRO("AD",APCLV)) D
  1.  ...S APCLC=0 W !?3,"DXs: "
  1.  ...S APCLS=0 F  S APCLS=$O(^AMHRPRO("AD",APCLV,APCLS)) Q:APCLS'=+APCLS!($D(APCLQUIT))  D
  1.  ....S APCLC=APCLC+1
  1.  ....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9002011.01,APCLS,.01),?17,$E($$VAL^XBDIQ1(9002011.01,APCLS,.04),1,60)
  1.  ..I $P(APCLY,U,1)="REF" S APCLD=$P(APCLY,U,7)  D
  1.  ...K APCLV S A="APCLV(",B=DFN_"^ALL VISITS;DURING "_$$FMTE^XLFDT(APCLD)_"-"_$$FMTE^XLFDT(APCLD),E=$$START1^APCLDF(B,A)
  1.  ...I $D(APCLV) S APCLV1=0 F  S APCLV1=$O(APCLV(APCLV1)) Q:APCLV1'=+APCLV1  S APCLV=$P(APCLV(APCLV1),U,5) D
  1.  ....S APCLC=0 W !?3,"DXs: "
  1.  ....S APCLS=0 F  S APCLS=$O(^AUPNVPOV("AD",APCLV,APCLS)) Q:APCLS'=+APCLS!($D(APCLQUIT))  D
  1.  .....S APCLC=APCLC+1
  1.  .....W:APCLC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,APCLS,.01),?17,$E($$VAL^XBDIQ1(9000010.07,APCLS,.04),1,60)
  1.  ..W !?3,"Primary Provider on Visit: ",?31,$P(APCLY,U,2)
  1.  ..W !?3,"     Primary who screened: ",?31,$P(APCLY,U,16)
  1.  ..I 'APCLDP W ! Q
  1.  ..K APCLZ S X=$$VAL^XBDIQ1(9002011.55,DFN,.02) I X]"" S APCLZ("MENTAL HEALTH")=X
  1.  ..S X=$$VAL^XBDIQ1(9002011.55,DFN,.03) I X]"" S APCLZ("SOCIAL SERVICES")=X
  1.  ..S X=$$VAL^XBDIQ1(9002011.55,DFN,.04) I X]"" S APCLZ("CHEMICAL DEPENDENCY")=X
  1.  ..S X=$$VAL^XBDIQ1(9000001,DFN,.14) I X]"" S APCLZ("DESIGNATED PRIMARY PROVIDER")=X
  1.  ..S APCLXX=0 F  S APCLXX=$O(^BDPRECN("C",DFN,APCLXX)) Q:APCLXX'=+APCLXX  D
  1.  ...S A=$$VAL^XBDIQ1(90360.1,APCLXX,.01) I '$D(APCLZ(A)) S APCLZ(A)=$$VAL^XBDIQ1(90360.1,APCLXX,.03)
  1.  ..Q:'$D(APCLZ)
  1.  ..W !?3,"     Designated Providers: "
  1.  ..S APCLZ="",APCLC=0 F  S APCLZ=$O(APCLZ(APCLZ)) Q:APCLZ=""!($D(APCLQUIT))  D
  1.  ...Q:$$END
  1.  ...S APCLC=APCLC+1
  1.  ...W:APCLC'=1 ! W ?31,$S(APCLZ="DESIGNATED PRIMARY PROVIDER":"PRIMARY CARE",1:APCLZ),": ",APCLZ(APCLZ)
  1.  Q
  1. H ;
  1.  S APCLSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
  1.  Q
  1. N ;
  1.  S APCLSORV=$P(^DPT(DFN,0),U)
  1.  Q
  1. P ;
  1.  S APCLSORV=$P(APCLY,U,2)
  1.  Q
  1. R ;
  1.  S APCLSORV=$P(APCLY,U,3)
  1.  Q
  1. D ;
  1.  S APCLSORV=$P(APCLY,U,7)
  1.  Q
  1. A S APCLSORV=$P(APCLY,U,5)
  1.  Q
  1. G ;
  1.  S APCLSORV=$P(APCLY,U,6)
  1.  Q
  1. C ;
  1.  S APCLSORV=$P(APCLY,U,10)
  1.  Q
  1. T ;
  1.  S %=$$HRN^AUPNPAT(DFN,DUZ(2))
  1.  S %=%+10000000,%=$E(%,7,8)_"-"_+$E(%,2,8)
  1.  S APCLSORV=%
  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.  ;
  1. COVPAGE ;EP
  1.  W:$D(IOF) @IOF
  1.  W !?20,"********** IPV/DV SCREENING FOR SELECTED PATIENTS **********"
  1.  W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
  1.  W !!,"The following report contains an IPV/DV screening report based on the",!,"following criteria:"
  1. SHOW ;
  1.  W !!?6,"Patient must have had a screening between ",$$FMTE^XLFDT(APCLBD)," and ",$$FMTE^XLFDT(APCLED),!
  1.  ;W:APCLTYPE="S" !!?6,"Search Template: ",$P(^DIBT(APCLSEAT,0),U),!
  1.  W !?6,"Gender:  ",$S(APCLSEX="F":"FEMALES ONLY",APCLSEX="M":"MALES ONLY",APCLSEX="U":"UNKNOWN",APCLSEX="MFU":"ALL GENDERS",1:"")
  1.  I $D(APCLAGET) W !?6,"Age of Patients included: ",$P(APCLAGET,"-")," to ",$P(APCLAGET,"-",2)
  1.  I '$D(APCLAGET) W !?6,"All Ages included"
  1.  W !?6,"Patients must have had a screening during the time period with one of ",!?6,"the following screening results:"
  1.  W ! S X="" F  S X=$O(APCLREST(X)) Q:X'=+X  D
  1.  .I X=1 W ?8,"NEGATIVE"
  1.  .I X=2 W "  ","PRESENT"
  1.  .I X=3 W "  ","PAST"
  1.  .I X=4 W "  ","PRESENT AND PAST"
  1.  .I X=5 W "  ","REFUSED"
  1.  .I X=6 W "  ","UNABLE TO SCREEN"
  1.  .I X=7 W !?8,"SCREENINGS WITH NO RECORDED RESULT"
  1.  I $D(APCLCLNT) W !,"Screenings done in the following clinics are included:" D
  1.  .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)_")"
  1.  I '$D(APCLCLNT),APCLEXBH W !,"Screenings done in ALL clinics included"
  1.  I 'APCLEXBH W !,"Behavioral Health Clinics excluded, all other clinics included."
  1.  I APCLDESP]"" W !,"Only patients whose Designated Primary Care Provider is ",!?6,$P(^VA(200,APCLDESP,0),U)," are included"
  1.  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."
  1.  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."
  1.  I '$D(APCLPROV) W !,"Visits to any Primary Provider are included"
  1.  I '$D(APCLSPRV) W !,"Visits on which any provider did the screening are included"
  1.  I $D(APCLPROV) W !,"Only screenings on which ",$P(^VA(200,APCLPROV,0),U)," was the primary provider",!?6,"on the visit are included"
  1.  I $D(APCLSPRV) W !,"Only screenings on which ",$P(^VA(200,APCLSPRV,0),U)," was the primary provider",!?6,"on the visit are included"
  1.  D PAUSE
  1.  Q
  1. PAUSE ; 
  1.  Q:$E(IOST)'="C"
  1.  Q:IO'=IO(0)
  1.  S DIR(0)="E",DIR("A")="Press return to continue or '^' to quit" D ^DIR K DIR,DA
  1.  S:$D(DIRUT) APCLQUIT=1
  1.  W:$D(IOF) @IOF
  1.  Q