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

AMHRC4.m

Go to the documentation of this file. 
  1. AMHRC4 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N DAYS 03 Jun 2009 12:08 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
  1.  ;
  1. START ;
  1.  I '$D(IOF) D HOME^%ZIS
  1.  W @(IOF),!!
  1.  W "*******  CLIENTS SEEN AT LEAST X TIMES WITH NO CASE OPEN DATE  *******",!!
  1.  W "This report will produce a list of patients, in a date range specified"
  1.  W !,"by the user, who have been seen a certain number of times but do not"
  1.  W !,"have open cases.  The user, based on their program's standards"
  1.  W !,"of care, specifies when a case is to be opened.  For example,"
  1.  W !,"a case will be opened if a patient has been seen at least (3) times."
  1.  W !
  1.  ;
  1.  I '$D(^AMHSITE(DUZ(2),16,DUZ)) D
  1.  .W !,"This report will only include Cases on which you are the documented"
  1.  .W !,"provider.",!!
  1.  D DBHUSRP^AMHUTIL,DBHUSR^AMHUTIL,PAUSE^AMHLEA
  1. DATES K AMHED,AMHBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
  1.  D ^DIR G:Y<1 XIT S AMHBD=Y
  1.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
  1.  D ^DIR G:Y<1 XIT  S AMHED=Y
  1.  ;
  1.  I AMHED<AMHBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
  1. PROG ;
  1.  S AMHPROG=""
  1.  ;S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  ;G:$D(DIRUT) DATES
  1.  ;I Y="A" G DAYS
  1.  S DIR(0)="9002011,.02",DIR("A")="Run Report for which PROGRAM" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) DATES
  1.  I X="" G DATES
  1.  S AMHPROG=Y
  1. PROV ;
  1.  S AMHPROV=""
  1.  S DIR(0)="S^A:All Providers;O:One Provider",DIR("A")="Include visits to",DIR("B")="A" K DA D ^DIR K DIR
  1.  G:$D(DIRUT) XIT
  1.  I Y="A" G DAYS
  1.  S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC
  1.  K DIC,DA
  1.  I Y=-1 G PROV
  1.  S AMHPROV=+Y
  1. DAYS ;
  1.  S AMHDAYS=0
  1.  S DIR(0)="NA^1:999:0",DIR("A")="Enter the number of visits (X number of visits with no case opened): " K DA D ^DIR K DIR
  1.  I $D(DIRUT) W !,"Bye..." D XIT Q
  1.  I Y="" D XIT Q
  1.  S AMHDAYS=Y
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G DAYS
  1. ZIS ;
  1.  S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
  1.  I $D(DIRUT) G XIT
  1.  I $G(Y)="B" D BROWSE,XIT Q
  1.  S XBRC="PROC^AMHRC4",XBRP="PRINT^AMHRC4",XBNS="AMH",XBRX="XIT^AMHRC4"
  1.  D ^XBDBQUE
  1. XIT ;
  1.  D EN^XBVK("AMH")
  1.  D KILL^AUPNPAT
  1.  Q
  1.  ;
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^AMHRC4"")"
  1.  S XBNS="AMH",XBRC="PROC^AMHRC4",XBRX="XIT^AMHRC4",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. PROC ;EP - entry point for processing
  1.  S AMHPCNT=0,AMHCCNT=0
  1.  S AMHJOB=$J,AMHBTH=$H,AMHBT=$H
  1.  D XTMP^AMHUTIL("AMHRC4","BH - REPORT - SEEN NOT OPEN")
  1.  S AMHODAT=AMHSD F  S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED)  D PROC1
  1.  S AMHET=$H
  1.  K AMHCASE
  1.  Q
  1. PROC1 ;
  1.  S AMHVIEN=0 F  S AMHVIEN=$O(^AMHREC("B",AMHODAT,AMHVIEN)) Q:AMHVIEN'=+AMHVIEN  D PROC2
  1.  Q
  1. PROC2 ;
  1.  Q:'$D(^AMHREC(AMHVIEN,0))
  1.  Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHVIEN)
  1.  ;I AMHPROG]"",$P(^AMHREC(AMHVIEN,0),U,2)'=AMHPROG Q  ;not correct program visit
  1.  S DFN=$P(^AMHREC(AMHVIEN,0),U,8)
  1.  Q:'DFN  ;not patient record
  1.  Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
  1.  Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
  1.  I $D(^XTMP("AMHRC4",AMHJOB,AMHBTH,"PATIENTS PROCESSED",DFN)) Q  ;already processed this patient
  1.  S X=$$VS(DFN,AMHBD,AMHED,AMHPROG,AMHPROV)  ;x=# of visits in date range
  1.  Q:$P(X,U)<AMHDAYS  ;not enough visits
  1.  ;now check for case open date
  1.  S AMHLASTD=$P(X,U,2)
  1.  S AMHLASTV=$P(X,U,3)
  1.  S AMHCV=$P(X,U,1)
  1.  S X=0,G=0 F  S X=$O(^AMHPCASE("C",DFN,X)) Q:X'=+X  D
  1.  .Q:'$$ALLOWCD^AMHLCD(DUZ,X)
  1.  .I $P(^AMHPCASE(X,0),U,5)]"",$P(^AMHPCASE(X,0),U,5)<AMHLASTD Q  ;closed before last visit date
  1.  .S G=1  ;has case open
  1.  .Q
  1.  Q:G
  1.  S ^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",$P(^DPT(DFN,0),U),DFN)=AMHCV_U_AMHLASTV_U_AMHLASTD,AMHPCNT=AMHPCNT+1
  1.  S ^XTMP("AMHRC4",AMHJOB,AMHBTH,"PATIENTS PROCESSED",DFN)=""
  1.  Q
  1. VS(P,BD,ED,R,W) ;
  1.  I '$D(^AMHREC("C",P)) Q 0
  1.  NEW S,X,Y,Z,C,A,B
  1.  S C=0,Y="",Z=""
  1.  S S=$$FMADD^XLFDT(BD,-1)_".9999"
  1.  F  S S=$O(^AMHREC("AF",P,S)) Q:S=""!($P(S,".")>ED)  D
  1.  .S X=0 F  S X=$O(^AMHREC("AF",P,S,X)) Q:X'=+X  D
  1.  ..I $$NS(X) Q  ;don't count no shows
  1.  ..I R]"",$P(^AMHREC(X,0),U,2)'=R Q
  1.  ..Q:'$$ALLOWVI^AMHUTIL(DUZ,X)
  1.  ..I W]"" D  Q:'G
  1.  ...S G=0
  1.  ...S A=0 F  S A=$O(^AMHRPROV("AD",X,A)) Q:A'=+A!(G)  I $P($G(^AMHRPROV(A,0)),U)=W S G=1
  1.  ..S C=C+1,Y=S,Z=X ;Y is last date
  1.  ..Q
  1.  .Q
  1.  Q C_U_Y_U_Z
  1. NS(V) ;
  1.  NEW H,I,J,K,DNKA
  1.  S DNKA=0
  1.  S H=0 F  S H=$O(^AMHRPRO("AD",V,H)) Q:H'=+H!(DNKA)  D
  1.  .I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8 S DNKA=1 Q
  1.  .I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.1 S DNKA=1 Q
  1.  .I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.11 S DNKA=1 Q
  1.  .I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.2 S DNKA=1 Q
  1.  .I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.21 S DNKA=1 Q
  1.  .I $P(^AMHPROB($P(^AMHRPRO(H,0),U),0),U)=8.3 S DNKA=1 Q
  1.  .Q
  1.  Q DNKA
  1. PRINT ;
  1.  S AMH80D="-------------------------------------------------------------------------------"
  1.  S AMHPG=0 D HEAD
  1.  I '$D(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS")) W !!,"NO PATIENTS TO REPORT" G DONE
  1.  S DFN="" K AMHQ
  1.  S AMHNAME="" F  S AMHNAME=$O(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME)) Q:AMHNAME=""!($D(AMHQ))  D
  1.  .S DFN=0 F  S DFN=$O(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ))  D PRN
  1.  G:$D(AMHQ) DONE
  1.  W !!,"Total Number of Patients: ",AMHPCNT,!
  1. DONE ;
  1.  K ^XTMP("AMHRC4",AMHJOB,AMHBTH),AMHJOB,AMHBTH
  1.  Q
  1. PRN ;
  1.  I $Y>(IOSL-4) D HEAD Q:$D(AMHQ)
  1.  S AMHHRCN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"<none>")
  1.  W !,$E($P(^DPT(DFN,0),U),1,15),?18,AMHHRCN
  1.  W ?26,$P(^DPT(DFN,0),U,2) S Y=$P(^DPT(DFN,0),U,3) W ?28,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
  1.  W ?38,$P(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,1)
  1.  W ?45,$$D($P(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,3))
  1.  S V=$P(^XTMP("AMHRC4",AMHJOB,AMHBTH,"HITS",AMHNAME,DFN),U,2)
  1.  W ?56,$$LASTDX(V)
  1.  W ?65,$E($$PPNAME^AMHUTIL(V),1,14)
  1.  Q
  1. LASTDX(V) ;
  1.  ;get last pov
  1.  NEW X
  1.  S X=$O(^AMHRPRO("AD",V,0))
  1.  I X="" Q ""
  1.  Q $$VAL^XBDIQ1(9002011.01,X,.01)
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S AMHPG=AMHPG+1
  1.  W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
  1.  W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!
  1.  W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
  1.  S X="PATIENTS SEEN AT LEAST "_AMHDAYS_" TIMES WITH NO CASE OPEN DATE" W $$CJ^XLFSTR(X,80),!
  1.  S X="VISIT DATE RANGE: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED) W $$CJ^XLFSTR(X,80),!
  1.  I AMHPROG]"" S X="VISITS TO PROGRAM: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG) W !,$$CTR(X,80)
  1.  W !,"PATIENT NAME",?18,"CHART",?25,"SEX",?31,"DOB",?38,"#",?45,"LAST VISIT",?56,"LAST",?63,"PROVIDER"
  1.  W !?18,"NUMBER",?38,"VISITS",?56,"DX"
  1.  W !,$$REPEAT^XLFSTR("-",80),!
  1.  Q
  1. D(D) ;
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  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.  ;----------