AMHBHRP6 ; IHS/CMI/LAB - behavioral health display for GUI ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
TEST ;
D GARS1(.RETVAL,"01/01/2000","12/31/2005","A","A",,"S")
Q
GARS1(AMHARRAY,AMHBD,AMHED,AMHPROG,AMHS,AMHPRV,AMHPSP) ;EP - AMHBH RPT GARS 1
S JOB=$J,AMHGUI=1,XWBWRAP=1
S ZTIO="",ZTQUEUED=1
S AMHARRAY="^XTMP(""AMHRPT"","_$J_")"
K ^XTMP("AMHRPT",$J)
I $G(AMHBD)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed" D KILL Q
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(AMHED)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid ending date passed" D KILL Q
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(AMHPROG) S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid Program type passed" D KILL Q
S AMHPROG=AMHPROG
I "MSCOA"'[AMHPROG S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid Program type passed" D KILL Q
I AMHPROG="A" S AMHPROG=""
S AMHS=$G(AMHS)
I AMHS'="O"&(AMHS'="A") S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid parameter - one or all providers" D KILL Q
S AMHPRV=$G(AMHPRV)
I AMHPRV,'$D(^VA(200,AMHPRV,0)) S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid provider IEN passed" D KILL Q
I 'AMHPRV,AMHS="O" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Provider IEN not passed and type is O" D KILL Q
I $G(AMHPSP)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Primary / Secondary parameter not passed" D KILL Q
I "PS"'[AMHPSP S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid Primary/secondary parameter passed" D KILL Q
S AMHPSP=AMHPSP
K ^XTMP("AMHRPT",JOB)
S ^XTMP("AMHRPTRUN",JOB)=""
D ^XBKSET
D ^AMHRP21
;S ZTRTN="TSK^AMHBHRP6",ZTIO="",ZTDESC="AMH ACTIVE CLIENT LIST",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("^AMHRP2P","^XTMP(""AMHRPT"",JOB)")
S ^XTMP("AMHRPT",JOB,.5)=$O(^XTMP("AMHRPT",JOB,""),-1)+1
S ^XTMP("AMHRPTRUN",JOB)="DONE"
Q
;
KILL ;
D EN^XBVK("AMH")
K DFN
K AMHOA,AMHBT,AMHTOT
K AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
D XIT^AMHRP2
Q
AMHBHRP6 ; IHS/CMI/LAB - behavioral health display for GUI ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
TEST ;
+1 DO GARS1(.RETVAL,"01/01/2000","12/31/2005","A","A",,"S")
+2 QUIT
GARS1(AMHARRAY,AMHBD,AMHED,AMHPROG,AMHS,AMHPRV,AMHPSP) ;EP - AMHBH RPT GARS 1
+1 SET JOB=$JOB
SET AMHGUI=1
SET XWBWRAP=1
+2 SET ZTIO=""
SET ZTQUEUED=1
+3 SET AMHARRAY="^XTMP(""AMHRPT"","_$JOB_")"
+4 KILL ^XTMP("AMHRPT",$JOB)
+5 IF $GET(AMHBD)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed"
DO KILL
QUIT
+6 DO DT^DILF("X",AMHBD,.AMHBD)
+7 IF $GET(AMHBD)=-1
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed"
DO KILL
QUIT
+8 IF $GET(AMHED)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid ending date passed"
DO KILL
QUIT
+9 DO DT^DILF("X",AMHED,.AMHED)
+10 IF $GET(AMHED)=-1
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid ending date passed"
DO KILL
QUIT
+11 IF $GET(AMHPROG)
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid Program type passed"
DO KILL
QUIT
+12 SET AMHPROG=AMHPROG
+13 IF "MSCOA"'[AMHPROG
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid Program type passed"
DO KILL
QUIT
+14 IF AMHPROG="A"
SET AMHPROG=""
+15 SET AMHS=$GET(AMHS)
+16 IF AMHS'="O"&(AMHS'="A")
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid parameter - one or all providers"
DO KILL
QUIT
+17 SET AMHPRV=$GET(AMHPRV)
+18 IF AMHPRV
IF '$DATA(^VA(200,AMHPRV,0))
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid provider IEN passed"
DO KILL
QUIT
+19 IF 'AMHPRV
IF AMHS="O"
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Provider IEN not passed and type is O"
DO KILL
QUIT
+20 IF $GET(AMHPSP)=""
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Primary / Secondary parameter not passed"
DO KILL
QUIT
+21 IF "PS"'[AMHPSP
SET ^XTMP("AMHRPT",JOB,.5)=2
SET ^XTMP("AMHRPT",JOB,1)="Invalid Primary/secondary parameter passed"
DO KILL
QUIT
+22 SET AMHPSP=AMHPSP
+23 KILL ^XTMP("AMHRPT",JOB)
+24 SET ^XTMP("AMHRPTRUN",JOB)=""
+25 DO ^XBKSET
+26 DO ^AMHRP21
+27 ;S ZTRTN="TSK^AMHBHRP6",ZTIO="",ZTDESC="AMH ACTIVE CLIENT LIST",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD
+28 ;F I=1:1:120 Q:$G(^XTMP("AMHRPTRUN",$J))="DONE" H 1
+29 DO TSK
+30 DO KILL
+31 QUIT
+32 ;
TSK ;
+1 DO ^XBKSET
+2 SET ^XTMP("AMHRPTRUN",JOB)="START"
+3 DO GUIR^XBLM("^AMHRP2P","^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 DO EN^XBVK("AMH")
+2 KILL DFN
+3 KILL AMHOA,AMHBT,AMHTOT
+4 KILL AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+5 DO XIT^AMHRP2
+6 QUIT