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

AMHBS.m

Go to the documentation of this file. 
  1. AMHBS ; IHS/CMI/LAB - BROWSE VISITS ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;
  1. START ;
  1.  NEW AMHX,AMHY,AMHR0,DFN,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX,AMHV,AMHBD,AMHED
  1.  NEW D,R
  1.  K AMHV
  1.  W:$D(IOF) @IOF
  1.  W $$CTR("Browse Behavioral Health Soap Notes",80)
  1. PAT ;
  1.  S DFN=""
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
  1.  I Y<0 W !,"No Patient Selected." Q
  1.  S DFN=+Y
  1.  S Y=DFN D ^AUPNPAT
  1.  I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
  1. WHICH ;
  1.  S AMHQUIT=0
  1.  S AMHW=""
  1.  S DIR(0)="S^L:Patient's Last Visit;N:Patient's Last N Visits;D:Visits in a Date Range;A:All of this Patient's Visits;P:Visits to one Program"
  1.  S DIR("A")="Browse SOAP Notes for which subset of visits for "_$P(^DPT(DFN,0),U),DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  S AMHW=Y
  1.  I AMHW="S" S AMHW="SAN"
  1.  D @AMHW Q:AMHQUIT
  1.  ;
  1. BROWSE ;
  1.  K ^TMP("AMHBS",$J)
  1.  D GATHER
  1.  D EN^VALM("AMH BROWSE SOAP NOTES")
  1.  K ^TMP("AMHBS",$J)
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1. END ;
  1.  K AMHP,AMHQUIT,AMHW
  1.  Q
  1.  ;
  1. EP(DFN) ;EP to list for one patient
  1.  NEW AMHX,AMHY,AMHR0,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX,AMHV,AMHBD,AMHED
  1.  D FULL^VALM1
  1.  NEW D,R
  1.  K AMHV
  1.  I '$G(DFN) D PAT Q
  1.  W:$D(IOF) @IOF
  1.  W $$CTR("Browse Behavioral Health SOAP Notes",80)
  1.  S Y=DFN D ^AUPNPAT
  1.  D WHICH
  1.  Q
  1. L ;get patients last visit
  1.  ;AMHV array
  1.  I '$D(^AMHREC("AE",DFN)) W !!,"No visits on file for this patient.",! S AMHQUIT=1 Q
  1.  S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))
  1.  I R S AMHV(D,R)=""
  1.  Q
  1. SAN ;san only
  1.  S D=0,V=0
  1.  F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V  I $P(^AMHREC(V,0),U,33)="S" S AMHV(D,V)=""
  1.  Q
  1. N ;patients last N visits
  1.  S N=""
  1.  S DIR(0)="N^1:99:0",DIR("A")="How many visits should be displayed",DIR("B")="5" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S AMHQUIT=1 Q
  1.  S N=Y
  1.  S (C,D)=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!(C=N)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C=N)  S C=C+1,AMHV(D,V)=""
  1.  Q
  1. P ;on program
  1.  S N=""
  1.  S DIR(0)="9002011,.02",DIR("A")="Visits to Which Program",DIR("B")="M" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S AMHQUIT=1 Q
  1.  S N=Y
  1.  S D=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V  I $P(^AMHREC(V,0),U,2)=N S AMHV(D,V)=""
  1.  Q
  1. A ;all visits
  1.  S D=0,V=0
  1.  F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V  S AMHV(D,V)=""
  1.  Q
  1. D ;date rante
  1.  K AMHED,AMHBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date of Visit"
  1.  D ^DIR S:Y<1 AMHQUIT=1 Q:Y<1  S AMHBD=Y
  1.  K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Date of Visit"
  1.  D ^DIR S:Y<1 AMHQUIT=1 Q:Y<1  S AMHED=Y
  1.  ;
  1.  I AMHED<AMHBD D  G D
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  S E=9999999-AMHBD,D=9999999-AMHED-1_".99" F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!($P(D,".")>E)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V  S AMHV(D,V)=""
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S AMHQUIT=0
  1.  ;gather up all visit records in ^TMP("AMHBS",$J
  1.  D GATHER
  1.  D PRINT1
  1.  K ^TMP("AMHBS",$J)
  1.  Q
  1.  ;
  1. PRINT1 ;
  1.  W:$D(IOF) @IOF
  1.  NEW AMHX
  1.  S AMHX=0 F  S AMHX=$O(^TMP("AMHBS",$J,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT)  D
  1.  .I $Y>(IOSL-5) D FF Q:AMHQUIT
  1.  .W !,^TMP("AMHBS",$J,AMHX,0)
  1.  .Q
  1.  Q
  1. GATHER ;
  1.  K ^TMP("AMHBS",$J)
  1.  NEW AMHX,AMHI,AMHJ,AMHY,AMHZ,AMHC,AMHD
  1.  S AMHC=0
  1.  S X="Patient Name: "_$P(^DPT(DFN,0),U),$E(X,45)="DOB: "_$$FMTE^XLFDT($P(^DPT(DFN,0),U,3)) D S(X)
  1.  S X="HRN: "_$$HRN^AUPNPAT(DFN,DUZ(2)) D S(X)
  1.  S X=$TR($J("",80)," ","*") D S(X)
  1.  S AMHV=0,AMHD=0
  1.  F  S AMHD=$O(AMHV(AMHD)) Q:AMHD'=+AMHD  S AMHV=0 F  S AMHV=$O(AMHV(AMHD,AMHV)) Q:AMHV'=+AMHV  D
  1.  .I '$O(^AMHREC(AMHV,31,0)) Q
  1.  .S AMHR0=^AMHREC(AMHV,0)
  1.  .S X="Visit Date: "_$$FMTE^XLFDT($P(AMHR0,U)),$E(X,45)="Provider: "_$$PPNAME^AMHUTIL(AMHV) D S(X,1)
  1.  .S AMHX=0 F  S AMHX=$O(^AMHREC(AMHV,31,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT)  D
  1.  ..S X="",$E(X,3)=^AMHREC(AMHV,31,AMHX,0) D S(X)
  1.  ..Q
  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. FF ;EP
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT=1 Q
  1.  I $E(IOST)'="C" Q:'$P(AMHR0,U,8)  W !!,$TR($J(" ",79)," ","*"),!,$P(^DPT($P(AMHR0,U,8),0),U),?32,"HRN: " D
  1.  .S H=$P($G(^AUPNPAT($P(AMHR0,U,8),41,DUZ(2),0)),U,2)
  1.  .W H,?46,"DOB: ",$$FMTE^XLFDT($P(^DPT($P(AMHR0,U,8),0),U,3),"2D"),?59,"SSN: ",$$SSN^AMHUTIL($P(AMHR0,U,8)),!
  1.  W:$D(IOF) @IOF
  1.  Q
  1. HDR ; -- header code
  1.  Q
  1.  ;
  1. S(Y,F,C,T) ;EP - set up array
  1.  I '$G(F) S F=0
  1.  I '$G(T) S T=0
  1.  ;blank lines
  1.  F F=1:1:F S X="" D S1
  1.  S X=Y
  1.  I $G(C) S L=$L(Y),T=(80-L)/2 D  D S1 Q
  1.  .F %=1:1:(T-1) S X=" "_X
  1.  F %=1:1:T S X=" "_Y
  1.  D S1
  1.  Q
  1. S1 ;
  1.  S AMHC=AMHC+1
  1.  S ^TMP("AMHBS",$J,AMHC,0)=X
  1.  Q
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=$O(^TMP("AMHBS",$J,""),-1)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q