- BPCBHRP7 ; IHS/OIT/MJL - behavioral health display for GUI ;
- ;;1.5;BPC;;MAY 26, 2005
- ;
- ;
- ;
- TEST ;
- D GARS2(.RETVAL,"01/01/2000","12/31/2003","A","A",,"S")
- Q
- GARS2(BGUARRAY,BPCBD,BPCED,BPCPROG,BPCS,BPCPRV,BPCPSP) ;EP - BPCBH RPT GARS 2
- S JOB=$J,BPCGUI=1,XWBWRAP=1
- S ZTIO="",ZTQUEUED=1
- S BGUARRAY="^XTMP(""BPCRPT"","_$J_")"
- K ^XTMP("BPCRPT",$J)
- I $G(BPCBD)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed" D KILL Q
- 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(BPCED)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid ending date passed" D KILL Q
- 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(BPCPROG) S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid Program type passed" D KILL Q
- S AMHPROG=BPCPROG
- I "MSCOA"'[BPCPROG S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid Program type passed" D KILL Q
- I AMHPROG="A" S AMHPROG=""
- S AMHS=$G(BPCS)
- I AMHS'="O"&(AMHS'="A") S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid parameter - one or all providers" D KILL Q
- S AMHPRV=$G(BPCPRV)
- I AMHPRV,'$D(^VA(200,AMHPRV,0)) S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid provider IEN passed" D KILL Q
- I 'AMHPRV,AMHS="O" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Provider IEN not passed and type is O" D KILL Q
- I $G(BPCPSP)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Primary / Secondary parameter not passed" D KILL Q
- I "PS"'[BPCPSP S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid Primary/secondary parameter passed" D KILL Q
- S AMHPSP=BPCPSP
- K ^XTMP("BPCRPT",JOB)
- S ^XTMP("BPCRPTRUN",JOB)=""
- D ^XBKSET
- D ^AMHRP31
- S ZTRTN="TSK^BPCBHRP7",ZTIO="",ZTDESC="BPC ACTIVE CLIENT LIST",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("^AMHRP3P","^XTMP(""BPCRPT"",JOB)")
- S ^XTMP("BPCRPT",JOB,.5)=$O(^XTMP("BPCRPT",JOB,""),-1)+1
- S ^XTMP("BPCRPTRUN",JOB)="DONE"
- Q
- ;
- KILL ;
- D EN^XBVK("AMH")
- K DFN
- K AMHOA,AMHBT,AMHTOT
- K BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- D XIT^AMHRP3
- Q
- BPCBHRP7 ; IHS/OIT/MJL - behavioral health display for GUI ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- +2 ;
- +3 ;
- +4 ;
- TEST ;
- +1 DO GARS2(.RETVAL,"01/01/2000","12/31/2003","A","A",,"S")
- +2 QUIT
- GARS2(BGUARRAY,BPCBD,BPCED,BPCPROG,BPCS,BPCPRV,BPCPSP) ;EP - BPCBH RPT GARS 2
- +1 SET JOB=$JOB
- SET BPCGUI=1
- SET XWBWRAP=1
- +2 SET ZTIO=""
- SET ZTQUEUED=1
- +3 SET BGUARRAY="^XTMP(""BPCRPT"","_$JOB_")"
- +4 KILL ^XTMP("BPCRPT",$JOB)
- +5 IF $GET(BPCBD)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"
- DO KILL
- QUIT
- +6 DO DT^DILF("X",BPCBD,.AMHBD)
- +7 IF $GET(AMHBD)=-1
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"
- DO KILL
- QUIT
- +8 IF $GET(BPCED)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"
- DO KILL
- QUIT
- +9 DO DT^DILF("X",BPCED,.AMHED)
- +10 IF $GET(AMHED)=-1
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"
- DO KILL
- QUIT
- +11 IF $GET(BPCPROG)
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid Program type passed"
- DO KILL
- QUIT
- +12 SET AMHPROG=BPCPROG
- +13 IF "MSCOA"'[BPCPROG
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid Program type passed"
- DO KILL
- QUIT
- +14 IF AMHPROG="A"
- SET AMHPROG=""
- +15 SET AMHS=$GET(BPCS)
- +16 IF AMHS'="O"&(AMHS'="A")
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid parameter - one or all providers"
- DO KILL
- QUIT
- +17 SET AMHPRV=$GET(BPCPRV)
- +18 IF AMHPRV
- IF '$DATA(^VA(200,AMHPRV,0))
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid provider IEN passed"
- DO KILL
- QUIT
- +19 IF 'AMHPRV
- IF AMHS="O"
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Provider IEN not passed and type is O"
- DO KILL
- QUIT
- +20 IF $GET(BPCPSP)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Primary / Secondary parameter not passed"
- DO KILL
- QUIT
- +21 IF "PS"'[BPCPSP
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid Primary/secondary parameter passed"
- DO KILL
- QUIT
- +22 SET AMHPSP=BPCPSP
- +23 KILL ^XTMP("BPCRPT",JOB)
- +24 SET ^XTMP("BPCRPTRUN",JOB)=""
- +25 DO ^XBKSET
- +26 DO ^AMHRP31
- +27 SET ZTRTN="TSK^BPCBHRP7"
- SET ZTIO=""
- SET ZTDESC="BPC ACTIVE CLIENT LIST"
- SET ZTSAVE("AMH*")=""
- SET ZTSAVE("JOB")=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +28 FOR I=1:1:120
- IF $GET(^XTMP("BPCRPTRUN",$JOB))="DONE"
- QUIT
- HANG 1
- +29 DO KILL
- +30 QUIT
- +31 ;
- TSK ;
- +1 DO ^XBKSET
- +2 SET ^XTMP("BPCRPTRUN",JOB)="START"
- +3 DO GUIR^XBLM("^AMHRP3P","^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 DO EN^XBVK("AMH")
- +2 KILL DFN
- +3 KILL AMHOA,AMHBT,AMHTOT
- +4 KILL BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +5 DO XIT^AMHRP3
- +6 QUIT
