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

AMHRE1.m

Go to the documentation of this file. 
  1. AMHRE1 ; IHS/CMI/LAB - ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
  1.  ;
  1. START ;
  1.  D XIT
  1.  I '$D(IOF) D HOME^%ZIS
  1.  W @(IOF),!!
  1.  K AMHQ
  1.  I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
  1.  D INFORM
  1. TYPE ; type of problem code
  1.  S AMHPTYPE=""
  1.  S DIR(0)="S^P:Problem Code and all diagnosis codes grouped under it;D:Individual Problem or diagnosis codes",DIR("A")="Which Type",DIR("B")="P" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  S AMHPTYPE=Y
  1.  I AMHPTYPE="P" G PROBCODE
  1. PROBLIST ;get problem list
  1.  K AMHPROB S AMHC=0
  1. PROB1 ;
  1.  W ! K DIC S DIC="^AMHPROB(",DIC(0)="AEMQ",DIC("A")="Enter "_$S(AMHC=0:"",1:"Another ")_"Problem/Diagnosis Code: " D ^DIC
  1.  I Y=-1,'$D(AMHPROB) W !!,"No problems selected.  Exiting." D XIT Q
  1.  I Y=-1,$O(AMHPROB(0)) G GETDATES
  1.  I X="",$O(AMHPROB(0)) G GETDATES
  1.  S AMHC=AMHC+1,AMHPROB(+Y)=""
  1.  G PROB1
  1. PROBCODE ;
  1.  K AMHPROB S AMHC=0
  1. PROB2 ;
  1.  W ! K DIC S DIC="^AMHPROBC(",DIC(0)="AEMQ",DIC("A")="Enter "_$S(AMHC=0:"",1:"Another ")_"Problem Code: " D ^DIC
  1.  I Y=-1,'$D(AMHPROB) W !!,"No problems selected.  Exiting." D XIT Q
  1.  I Y=-1,$O(AMHPROB(0)) G GETDATES
  1.  I X="",$O(AMHPROB(0)) G GETDATES
  1.  W !!,"The following Problem/Diagnosis codes will be included: "
  1.  S X=0 F  S X=$O(^AMHPROB("AC",+Y,X)) Q:X'=+X  S AMHPROB(X)="" W "  ",$P(^AMHPROB(X,0),U) S AMHC=AMHC+1
  1.  G PROB2
  1. GETDATES ;
  1.  W:$D(IOF) @IOF W !,"You have selected the following Problem/Diagnosis Codes"
  1.  S X=0 F  S X=$O(AMHPROB(X)) Q:X'=+X  W !?5,$P(^AMHPROB(X,0),U),?13,$P(^AMHPROB(X,0),U,2)
  1. BD ;get beginning date
  1.  W !!!,"Please enter the date range during which the patient should have been seen ",!,"with one of these problems.",!
  1.  S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G XIT
  1.  S AMHBD=Y
  1. ED ;get ending date
  1.  W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter Ending Visit Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  S AMHED=Y
  1.  S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"
  1.  ;
  1. DEMO ;
  1.  D DEMOCHK^AMHUTIL1(.AMHDEMO)
  1.  I AMHDEMO=-1 G GETDATES
  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^AMHRE1",XBRP="PRINT^AMHRE1",XBNS="AMH",XBRX="XIT^AMHRE1"
  1.  D ^XBDBQUE
  1. XIT ;
  1.  D EN^XBVK("AMH"),^XBFMK
  1.  Q
  1.  ;
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^AMHRE1"")"
  1.  S XBNS="AMH",XBRC="PROC^AMHRE1",XBRX="XIT^AMHRE1",XBIOP=0 D ^XBDBQUE
  1.  Q
  1.  ;
  1. PROC ;EP - called from xbdbque
  1.  S AMHBT=$H
  1.  S ^XTMP("AMHRE1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"BH PROBLEM REPORT"
  1.  S AMHJ=$J,AMHH=$H,AMHCNT=0
  1.  K ^XTMP("AMHRE1",AMHJ,AMHH)
  1.  ;$O through all visits and set for patient once
  1.  F  S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED)  D
  1.  .S (AMHR,AMHRCNT)=0 F  S AMHR=$O(^AMHREC("B",AMHSD,AMHR)) Q:AMHR'=+AMHR  I $D(^AMHREC(AMHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S AMHR0=^(0) D PROC1
  1.  S AMHET=$H
  1.  Q
  1. PROC1 ;
  1.  Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
  1.  S DFN=$P(AMHR0,U,8) Q:DFN=""  ;do not use if no patient
  1.  Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
  1.  Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
  1.  Q:'$D(^AMHRPRO("AD",AMHR))  ;quit if no problems entered
  1.  ;find pov
  1.  S (AMHFOUND,X)=0,AMHSORT="" F  S X=$O(^AMHRPRO("AD",AMHR,X)) Q:X'=+X!(AMHFOUND)  S P=$P(^AMHRPRO(X,0),U) I $D(AMHPROB(P)) D
  1.  .Q:$D(^XTMP("AMHRE1",AMHJ,AMHH,$P(^DPT(DFN,0),U),DFN,P))  ;already got this pov
  1.  .S ^XTMP("AMHRE1",AMHJ,AMHH,$P(^DPT(DFN,0),U),DFN,P)=AMHR
  1.  .Q
  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.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  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. INFORM ;inform user what this report is all about
  1.  W !!,"This report will list all patients who have been seen for a diagnosis/problem",!,"selected by the user in the date range selected by the user.  For example,"
  1.  W !,"you may enter all suicide problem codes (39, 40, 41) and you will get a list",!,"of all patients seen for suicide and can then use this report",!,"to assist in follow up activities.",!
  1.  W !!,"The report will list Designated Provider, Patient Name, date seen for",!,"this problem, and date last seen.",!!
  1.  D DBHUSRP^AMHUTIL,DBHUSR^AMHUTIL,PAUSE^AMHLEA
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S AMHPG=0 D HEADER
  1.  I '$D(^XTMP("AMHRE1",AMHJ,AMHH)) W !!,"NO PATIENTS TO REPORT" G DONE
  1.  S DFN="" K AMHQ
  1.  S AMHNAME="" F  S AMHNAME=$O(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME)) Q:AMHNAME=""!($D(AMHQ))  D
  1.  .S DFN=0 F  S DFN=$O(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ))  D
  1.  ..I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)
  1.  ..W !,$E(AMHNAME,1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?34,$$D($$DOB^AUPNPAT(DFN)),?44,$P(^DPT(DFN,0),U,2) D
  1.  ...S AMHP=0,AMHC=0 F  S AMHP=$O(^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN,AMHP)) Q:AMHP'=+AMHP!($D(AMHQ))  D
  1.  ....S AMHR=^XTMP("AMHRE1",AMHJ,AMHH,AMHNAME,DFN,AMHP)
  1.  ....S AMHC=AMHC+1 I AMHC=1 W ?47,$$PPINI^AMHUTIL(AMHR),?52,$P(^AMHPROB(AMHP,0),U),?62,$$D($P(^AMHREC(AMHR,0),U)),?72,$$D($$LVD^AMHDPEE(DFN,"ID")) Q
  1.  ....I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)
  1.  ....W !?52,$P(^AMHPROB(AMHP,0),U),?62,$$D($P(^AMHREC(AMHR,0),U))
  1.  ....Q
  1.  ...Q
  1.  ..I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)
  1.  ..I $P($G(^AMHPATR(DFN,0)),U,2)]"" W !?3,"Designated MH Prov: ",$E($$VAL^XBDIQ1(9002011.55,DFN,.02),1,20)
  1.  ..S AMHS=0 I $P($G(^AMHPATR(DFN,0)),U,3) W !?3,"Designated SS Prov: ",$E($$VAL^XBDIQ1(9002011.55,DFN,.03),1,20) S AMHS=1
  1.  ..I $P($G(^AMHPATR(DFN,0)),U,4) W ?$S(AMHS:42,1:3),"Desginated CD Prov: ",$E($$VAL^XBDIQ1(9002011.55,DFN,.04),1,20)
  1.  ..Q
  1.  .Q
  1. DONE ;
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  W:$D(IOF) @IOF
  1.  K AMHTS,AMHS,AMHM,AMHET
  1.  K ^XTMP("AMHRE1",AMHJ,AMHH),AMHJ,AMHH
  1.  Q
  1.  ;
  1.  G:'AMHPG 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 AMHQ="" Q
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S AMHPG=AMHPG+1
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHPG,!
  1.  W !,$$CTR("PATIENTS SEEN WITH SELECTED DIAGNOSES/PROBLEMS",80),!
  1.  S X="Visit Dates: "_$$FMTE^XLFDT(AMHBD)_" to "_$$FMTE^XLFDT(AMHED) W $$CTR(X,80),!
  1.  W !,"PATIENT NAME",?27,"HRN",?34,"DOB",?43,"SEX",?47,"PROV",?52,"DX",?62,"DATE SEEN",?72,"LAST VIS"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q