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

AMHGOM.m

Go to the documentation of this file. 
  1. AMHGOM ; IHS/CMI/MAW - BROWSE VISITS ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1.  ;
  1. START ;
  1.  W:$D(IOF) @IOF
  1.  D EN^XBVK("AMH")
  1.  W !,$$CTR("GAF OUTCOME MEASURE - GAF Scores for One Patient",80),!!
  1.  W !,"This option is used to list GAF Scores for a patient in date order.",!!
  1.  D DBHUSR^AMHUTIL
  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 DFN,'$$ALLOWP^AMHUTIL(DUZ,DFN) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G PAT
  1.  I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
  1. WHICH ;
  1.  W !!,"Please note:  Only visits with GAF scores recorded will display on this",!,"list.",!
  1.  S AMHQUIT=0
  1.  S AMHW=""
  1.  K DIR S DIR(0)="S^N:Patient's Last N Visits;D:Visits in a Date Range;A:All of this Patient's Visits;R:Visits to One Program;P:Visits to One Provider"
  1.  S DIR("A")="Browse 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="P" S AMHW="PROV"
  1.  D @AMHW Q:AMHQUIT
  1.  ;
  1. BROWSE ;
  1.  K ^TMP("AMHGOM",$J)
  1.  D GATHER
  1.  D EN^VALM("AMH GAF SCORE VISITS")
  1.  K ^TMP("AMHGOM",$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("GAF Scores",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.  S (C,D)=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!(C>0)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C>0)  I $$ALLOWVI^AMHUTIL(DUZ,V) S C=C+1,AMHV(D,V)=""
  1.  ;I R S AMHV(D,R)=""
  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)  I $$ALLOWVI^AMHUTIL(DUZ,V) S C=C+1,AMHV(D,V)=""
  1.  Q
  1. R ;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,$$ALLOWVI^AMHUTIL(DUZ,V) 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  I $$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""
  1.  Q
  1. D ;date range
  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  I $$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""
  1.  Q
  1. P ;
  1.  S N=""
  1.  S DIR(0)="9002011.02,.01",DIR("A")="Visits to Which Provider",DIR("B")=$P(^VA(200,DUZ,0),U) 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("AF",DFN,D)) Q:D'=+D  S V=0 F  S V=$O(^AMHREC("AF",DFN,D,V)) Q:V'=+V  I $$ALLOWVI^AMHUTIL(DUZ,V),$P(^AMHREC(V,0),U,14)]"",$$PPINT^AMHUTIL(V)=N S AMHV(D,V)=""
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S AMHQUIT=0
  1.  ;gather up all visit records in ^TMP("AMHGOM",$J
  1.  D GATHER
  1.  D PRINT1
  1.  K ^TMP("AMHGOM",$J)
  1.  Q
  1.  ;
  1. PRINT1 ;
  1.  W:$D(IOF) @IOF
  1.  NEW AMHX
  1.  S AMHX=0 F  S AMHX=$O(^TMP("AMHGOM",$J,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT)  D
  1.  .I $Y>(IOSL-5) D FF Q:AMHQUIT
  1.  .W !,^TMP("AMHGOM",$J,AMHX,0)
  1.  .Q
  1.  Q
  1. GATHER ;
  1.  K ^TMP("AMHGOM",$J)
  1.  NEW AMHX,AMHI,AMHJ,AMHY,AMHZ,AMHC,AMHD,AMHGAFT
  1.  S AMHGAFT=0
  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 X="  Date",$E(X,14)="GAF",$E(X,19)="TYPE",$E(X,29)="PROVIDER",$E(X,45)="PG",$E(X,49)="Diagnosis/POV" D S(X)
  1.  S X="",$E(X,3)=$$REPEAT^XLFSTR("-",77) 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.  .S AMHR0=^AMHREC(AMHV,0)
  1.  .Q:$P(AMHR0,U,14)=""
  1.  .S AMHX="  "_$$D^AMHRPEC($P(AMHR0,U))
  1.  .S $E(AMHX,14)=$P(AMHR0,U,14)
  1.  .S $E(AMHX,19)=$E($P($G(^AMHREC(AMHV,11)),U,15),1,8)
  1.  .S $E(AMHX,29)=$E($$PPNAME^AMHUTIL(AMHV),1,15)
  1.  .S M=$P(^AMHREC(AMHV,0),U,2),M=$S(M="M":"MH",M="S":"SS",M="O":"OT",M="C":"CD",1:"")
  1.  .S $E(AMHX,45)=M
  1.  .S X=$O(^AMHRPRO("AD",AMHV,0))
  1.  .I X S $E(AMHX,49)=$$VAL^XBDIQ1(9002011.01,X,.01)_" - "_$E($$VAL^XBDIQ1(9002011.01,X,.04),1,23)
  1.  .D S(AMHX)
  1.  .S AMHGAFT=AMHGAFT+1
  1.  I 'AMHGAFT D S("No GAF scores to report.")
  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("AMHGOM",$J,AMHC,0)=X
  1.  Q
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=$O(^TMP("AMHGOM",$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