AMHBHRP5 ; IHS/CMI/LAB - behavioral health display for GUI ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
TEST ;
D DISPLAST(.RETVAL,40503,"D",,"01/01/1995","01/20/2005")
Q
DISPLAST(AMHARRAY,AMHPAT,AMHTYPE,AMHNUM,AMHBD,AMHED,AMHPROG) ;EP - AMHBH RPT LAST VISIT
NEW AMHR
S JOB=$J,AMHGUI=1,XWBWRAP=1
S ZTIO="",ZTQUEUED=1
S AMHARRAY="^XTMP(""AMHRPT"","_$J_")"
K ^XTMP("AMHRPT",$J)
I $G(AMHPAT)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid DFN of patient passed" D KILL Q
I $G(AMHTYPE)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid type of report type passed" D KILL Q
I "LNADPS"'[AMHTYPE S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid report type passed" D KILL Q
I $G(AMHTYPE)="N",$G(AMHNUM)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Number of visits not passed for N type" D KILL Q
I $G(AMHTYPE)="D",$G(AMHBD)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Beginning date not passed and type is date range" D KILL Q
I AMHBD]"" D DT^DILF("X",AMHBD,.AMHBD) I $G(AMHBD)=-1 S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed" D KILL Q
I $G(AMHTYPE)="D",$G(AMHED)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Ending date not passed and type is date range" D KILL Q
I AMHED]"" D DT^DILF("X",AMHED,.AMHED) I $G(AMHED)=-1 S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid ending date passed" D KILL Q
I $G(AMHTYPE)="P",$G(AMHPROG)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Program type not passed and type is program" D KILL Q
S (DFN,AMHPAT,AUPNPAT)=AMHPAT
K AMHV D @AMHTYPE
I '$O(AMHV(0)) S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="No visits found" ;cmi/maw 4/5/2010 PR 682 D KILL Q
S ^XTMP("AMHRPTRUN",JOB)=""
D ^XBKSET
;S ZTRTN="TSK^AMHBHRP5",ZTIO="",ZTDESC="AMH LAST VISIT DISPLAY",ZTSAVE("DFN")="",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD
;F I=1:1:120 Q:$G(^XTMP("AMHRPTRUN",$J))="DONE" H 1
D TSK
D KILL
Q
;
TSK ;
D ^XBKSET
S ^XTMP("AMHRPTRUN",JOB)="START"
D GUIR^XBLM("PRINT^AMHVD","^XTMP(""AMHRPT"",JOB)")
S ^XTMP("AMHRPT",JOB,.5)=$O(^XTMP("AMHRPT",JOB,""),-1)+1
S ^XTMP("AMHRPTRUN",JOB)="DONE"
Q
;
KILL ;
K DFN,AMHPAT,AUPNPAT
K AMHOA,AMHBT,AMHTOT
K AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
;D EN^XBVK("AMH")
Q
L ;get patients last visit
;AMHV array
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)=""
;I '$D(^AMHREC("AE",DFN)) Q
;S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))
;I R S AMHV(D,R)=""
Q
S ;san only
S D=0,V=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,33)="S",$$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""
Q
N ;patients last N visits
S (C,D)=0 F S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!(C=AMHNUM) S V=0 F S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C=AMHNUM) I $$ALLOWVI^AMHUTIL(DUZ,V) S C=C+1,AMHV(D,V)=""
Q
P ;on program
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)=AMHPROG,$$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""
Q
A ;all visits
S D=0,V=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 $$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""
Q
D ;date rante
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)=""
Q
AMHBHRP5 ; IHS/CMI/LAB - behavioral health display for GUI ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
TEST ;
+1 DO DISPLAST(.RETVAL,40503,"D",,"01/01/1995","01/20/2005")
+2 QUIT
DISPLAST(AMHARRAY,AMHPAT,AMHTYPE,AMHNUM,AMHBD,AMHED,AMHPROG) ;EP - AMHBH RPT LAST VISIT
+1 NEW AMHR
+2 SET JOB=$JOB
SET AMHGUI=1
SET XWBWRAP=1
+3 SET ZTIO=""
SET ZTQUEUED=1
+4 SET AMHARRAY="^XTMP(""AMHRPT"","_$JOB_")"
+5 KILL ^XTMP("AMHRPT",$JOB)
+6 IF $GET(AMHPAT)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid DFN of patient passed"
DO KILL
QUIT
+7 IF $GET(AMHTYPE)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid type of report type passed"
DO KILL
QUIT
+8 IF "LNADPS"'[AMHTYPE
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid report type passed"
DO KILL
QUIT
+9 IF $GET(AMHTYPE)="N"
IF $GET(AMHNUM)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Number of visits not passed for N type"
DO KILL
QUIT
+10 IF $GET(AMHTYPE)="D"
IF $GET(AMHBD)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Beginning date not passed and type is date range"
DO KILL
QUIT
+11 IF AMHBD]""
DO DT^DILF("X",AMHBD,.AMHBD)
IF $GET(AMHBD)=-1
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed"
DO KILL
QUIT
+12 IF $GET(AMHTYPE)="D"
IF $GET(AMHED)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Ending date not passed and type is date range"
DO KILL
QUIT
+13 IF AMHED]""
DO DT^DILF("X",AMHED,.AMHED)
IF $GET(AMHED)=-1
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid ending date passed"
DO KILL
QUIT
+14 IF $GET(AMHTYPE)="P"
IF $GET(AMHPROG)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Program type not passed and type is program"
DO KILL
QUIT
+15 SET (DFN,AMHPAT,AUPNPAT)=AMHPAT
+16 KILL AMHV
DO @AMHTYPE
+17 ;cmi/maw 4/5/2010 PR 682 D KILL Q
IF '$ORDER(AMHV(0))
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="No visits found"
+18 SET ^XTMP("AMHRPTRUN",JOB)=""
+19 DO ^XBKSET
+20 ;S ZTRTN="TSK^AMHBHRP5",ZTIO="",ZTDESC="AMH LAST VISIT DISPLAY",ZTSAVE("DFN")="",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD
+21 ;F I=1:1:120 Q:$G(^XTMP("AMHRPTRUN",$J))="DONE" H 1
+22 DO TSK
+23 DO KILL
+24 QUIT
+25 ;
TSK ;
+1 DO ^XBKSET
+2 SET ^XTMP("AMHRPTRUN",JOB)="START"
+3 DO GUIR^XBLM("PRINT^AMHVD","^XTMP(""AMHRPT"",JOB)")
+4 SET ^XTMP("AMHRPT",JOB,.5)=$ORDER(^XTMP("AMHRPT",JOB,""),-1)+1
+5 SET ^XTMP("AMHRPTRUN",JOB)="DONE"
+6 QUIT
+7 ;
KILL ;
+1 KILL DFN,AMHPAT,AUPNPAT
+2 KILL AMHOA,AMHBT,AMHTOT
+3 KILL AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+4 ;D EN^XBVK("AMH")
+5 QUIT
L ;get patients last visit
+1 ;AMHV array
+2 SET (C,D)=0
FOR
SET D=$ORDER(^AMHREC("AE",DFN,D))
IF D'=+D!(C>0)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V!(C>0)
QUIT
IF $$ALLOWVI^AMHUTIL(DUZ,V)
SET C=C+1
SET AMHV(D,V)=""
+3 ;I '$D(^AMHREC("AE",DFN)) Q
+4 ;S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))
+5 ;I R S AMHV(D,R)=""
+6 QUIT
S ;san only
+1 SET D=0
SET V=0
+2 FOR
SET D=$ORDER(^AMHREC("AE",DFN,D))
IF D'=+D
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V
QUIT
IF $PIECE(^AMHREC(V,0),U,33)="S"
IF $$ALLOWVI^AMHUTIL(DUZ,V)
SET AMHV(D,V)=""
+3 QUIT
N ;patients last N visits
+1 SET (C,D)=0
FOR
SET D=$ORDER(^AMHREC("AE",DFN,D))
IF D'=+D!(C=AMHNUM)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V!(C=AMHNUM)
QUIT
IF $$ALLOWVI^AMHUTIL(DUZ,V)
SET C=C+1
SET AMHV(D,V)=""
+2 QUIT
P ;on program
+1 SET D=0
FOR
SET D=$ORDER(^AMHREC("AE",DFN,D))
IF D'=+D
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V
QUIT
IF $PIECE(^AMHREC(V,0),U,2)=AMHPROG
IF $$ALLOWVI^AMHUTIL(DUZ,V)
SET AMHV(D,V)=""
+2 QUIT
A ;all visits
+1 SET D=0
SET V=0
+2 FOR
SET D=$ORDER(^AMHREC("AE",DFN,D))
IF D'=+D
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V
QUIT
IF $$ALLOWVI^AMHUTIL(DUZ,V)
SET AMHV(D,V)=""
+3 QUIT
D ;date rante
+1 SET E=9999999-AMHBD
SET D=9999999-AMHED-1_".99"
FOR
SET D=$ORDER(^AMHREC("AE",DFN,D))
IF D'=+D!($PIECE(D,".")>E)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V
QUIT
IF $$ALLOWVI^AMHUTIL(DUZ,V)
SET AMHV(D,V)=""
+2 QUIT
