BPCBHRP5 ; IHS/OIT/MJL - behavioral health display for GUI ;
;;1.5;BPC;;MAY 26, 2005
;
;
;
TEST ;
D DISPLAST(.RETVAL,87,"D",,"01/01/1995","01/20/2003")
Q
DISPLAST(BGUARRAY,BPCPAT,BPCTYPE,BPCNUM,BPCBD,BPCED,BPCPROG) ;EP - BPCBH RPT LAST VISIT
NEW AMHR
S JOB=$J,BPCGUI=1,XWBWRAP=1
S ZTIO="",ZTQUEUED=1
S BGUARRAY="^XTMP(""BPCRPT"","_$J_")"
K ^XTMP("BPCRPT",$J)
I $G(BPCPAT)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid DFN of patient passed" D KILL Q
I $G(BPCTYPE)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid type of report type passed" D KILL Q
I "LNADPS"'[BPCTYPE S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid report type passed" D KILL Q
I $G(BPCTYPE)="N",$G(BPCNUM)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Number of visits not passed for N type" D KILL Q
I $G(BPCTYPE)="D",$G(BPCBD)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Beginning date not passed and type is date range" D KILL Q
I BPCBD]"" D DT^DILF("X",BPCBD,.AMHBD) I $G(AMHBD)=-1 S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed" D KILL Q
I $G(BPCTYPE)="D",$G(BPCED)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Ending date not passed and type is date range" D KILL Q
I BPCED]"" D DT^DILF("X",BPCED,.AMHED) I $G(AMHED)=-1 S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid ending date passed" D KILL Q
I $G(BPCTYPE)="P",$G(BPCPROG)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Program type not passed and type is program" D KILL Q
S (DFN,AMHPAT,AUPNPAT)=BPCPAT
K AMHV D @BPCTYPE
I '$O(AMHV(0)) S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="No visits found" D KILL Q
S ^XTMP("BPCRPTRUN",JOB)=""
D ^XBKSET
S ZTRTN="TSK^BPCBHRP5",ZTIO="",ZTDESC="BPC LAST VISIT DISPLAY",ZTSAVE("DFN")="",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD
F I=1:1:120 Q:$G(^XTMP("BPCRPTRUN",$J))="DONE" H 1
D KILL
Q
;
TSK ;
D ^XBKSET
S ^XTMP("BPCRPTRUN",JOB)="START"
D GUIR^XBLM("PRINT^AMHVD","^XTMP(""BPCRPT"",JOB)")
S ^XTMP("BPCRPT",JOB,.5)=$O(^XTMP("BPCRPT",JOB,""),-1)+1
S ^XTMP("BPCRPTRUN",JOB)="DONE"
Q
;
KILL ;
K DFN,AMHPAT,AUPNPAT
K AMHOA,AMHBT,AMHTOT
K BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
D EN^XBVK("AMH")
Q
L ;get patients last visit
;AMHV array
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" 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=BPCNUM) S V=0 F S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C=BPCNUM) 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)=BPCPROG 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 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 S AMHV(D,V)=""
Q
BPCBHRP5 ; IHS/OIT/MJL - behavioral health display for GUI ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
+3 ;
+4 ;
TEST ;
+1 DO DISPLAST(.RETVAL,87,"D",,"01/01/1995","01/20/2003")
+2 QUIT
DISPLAST(BGUARRAY,BPCPAT,BPCTYPE,BPCNUM,BPCBD,BPCED,BPCPROG) ;EP - BPCBH RPT LAST VISIT
+1 NEW AMHR
+2 SET JOB=$JOB
SET BPCGUI=1
SET XWBWRAP=1
+3 SET ZTIO=""
SET ZTQUEUED=1
+4 SET BGUARRAY="^XTMP(""BPCRPT"","_$JOB_")"
+5 KILL ^XTMP("BPCRPT",$JOB)
+6 IF $GET(BPCPAT)=""
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Invalid DFN of patient passed"
DO KILL
QUIT
+7 IF $GET(BPCTYPE)=""
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Invalid type of report type passed"
DO KILL
QUIT
+8 IF "LNADPS"'[BPCTYPE
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Invalid report type passed"
DO KILL
QUIT
+9 IF $GET(BPCTYPE)="N"
IF $GET(BPCNUM)=""
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Number of visits not passed for N type"
DO KILL
QUIT
+10 IF $GET(BPCTYPE)="D"
IF $GET(BPCBD)=""
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Beginning date not passed and type is date range"
DO KILL
QUIT
+11 IF BPCBD]""
DO DT^DILF("X",BPCBD,.AMHBD)
IF $GET(AMHBD)=-1
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"
DO KILL
QUIT
+12 IF $GET(BPCTYPE)="D"
IF $GET(BPCED)=""
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Ending date not passed and type is date range"
DO KILL
QUIT
+13 IF BPCED]""
DO DT^DILF("X",BPCED,.AMHED)
IF $GET(AMHED)=-1
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"
DO KILL
QUIT
+14 IF $GET(BPCTYPE)="P"
IF $GET(BPCPROG)=""
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="Program type not passed and type is program"
DO KILL
QUIT
+15 SET (DFN,AMHPAT,AUPNPAT)=BPCPAT
+16 KILL AMHV
DO @BPCTYPE
+17 IF '$ORDER(AMHV(0))
SET ^XTMP("BPCRPT",JOB,.5)=2
SET ^XTMP("BPCRPT",JOB,1)="No visits found"
DO KILL
QUIT
+18 SET ^XTMP("BPCRPTRUN",JOB)=""
+19 DO ^XBKSET
+20 SET ZTRTN="TSK^BPCBHRP5"
SET ZTIO=""
SET ZTDESC="BPC LAST VISIT DISPLAY"
SET ZTSAVE("DFN")=""
SET ZTSAVE("AMH*")=""
SET ZTSAVE("JOB")=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+21 FOR I=1:1:120
IF $GET(^XTMP("BPCRPTRUN",$JOB))="DONE"
QUIT
HANG 1
+22 DO KILL
+23 QUIT
+24 ;
TSK ;
+1 DO ^XBKSET
+2 SET ^XTMP("BPCRPTRUN",JOB)="START"
+3 DO GUIR^XBLM("PRINT^AMHVD","^XTMP(""BPCRPT"",JOB)")
+4 SET ^XTMP("BPCRPT",JOB,.5)=$ORDER(^XTMP("BPCRPT",JOB,""),-1)+1
+5 SET ^XTMP("BPCRPTRUN",JOB)="DONE"
+6 QUIT
+7 ;
KILL ;
+1 KILL DFN,AMHPAT,AUPNPAT
+2 KILL AMHOA,AMHBT,AMHTOT
+3 KILL BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+4 DO EN^XBVK("AMH")
+5 QUIT
L ;get patients last visit
+1 ;AMHV array
+2 IF '$DATA(^AMHREC("AE",DFN))
QUIT
+3 SET D=$ORDER(^AMHREC("AE",DFN,""))
SET R=$ORDER(^AMHREC("AE",DFN,D,""))
+4 IF R
SET AMHV(D,R)=""
+5 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"
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=BPCNUM)
QUIT
SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,D,V))
IF V'=+V!(C=BPCNUM)
QUIT
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)=BPCPROG
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
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
SET AMHV(D,V)=""
+2 QUIT
