- BPCBHR1 ; IHS/OIT/MJL - behavioral health display for GUI ;
- ;;1.5;BPC;;MAY 26, 2005
- ;
- ;
- ;
- TEST ;
- D TPRES(.RETVAL,"01/01/1900","12/31/2003","A","")
- Q
- TPRES(BGUARRAY,BPCBD,BPCED,BPCOA,BPCTHER) ;EP - BPCBH RPT TP NEED RESOLVEDED
- TPRES1 S JOB=$J,BPCGUI=1,XWBWRAP=1
- S ZTIO="",ZTQUEUED=1
- S BGUARRAY="^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(BPCOA)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="All or One variable not passed" D KILL Q
- I "OA"'[BPCOA S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="All or One variable not passed as O or A" D KILL Q
- S AMHOA=BPCOA
- I AMHOA="O",$G(BPCTHER)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="One provider parameter set, provider not defined" D KILL Q
- I AMHOA="O",'$D(^VA(200,BPCTHER,0)) S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Provider IEN passed is not valid" D KILL Q
- S AMHTHER=$G(BPCTHER)
- K ^XTMP("BPCRPT",JOB)
- S ^XTMP("BPCRPTRUN",JOB)=""
- D ^XBKSET
- D PROC^AMHLETR
- S ZTRTN="TSK^BPCBHR1",ZTIO="",ZTDESC="BPC TP RES REPORT",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^AMHLETR","^XTMP(""BPCRPT"",JOB)")
- S ^XTMP("BPCRPT",JOB,.5)=$O(^XTMP("BPCRPT",JOB,""),-1)+1
- S ^XTMP("BPCRPTRUN",JOB)="DONE"
- Q
- ;
- KILL ;
- K AMHOA,AMHBT,AMHTOT
- K BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- D XIT^AMHLETR
- Q
- BPCBHR1 ; IHS/OIT/MJL - behavioral health display for GUI ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- +2 ;
- +3 ;
- +4 ;
- TEST ;
- +1 DO TPRES(.RETVAL,"01/01/1900","12/31/2003","A","")
- +2 QUIT
- TPRES(BGUARRAY,BPCBD,BPCED,BPCOA,BPCTHER) ;EP - BPCBH RPT TP NEED RESOLVEDED
- TPRES1 SET JOB=$JOB
- SET BPCGUI=1
- SET XWBWRAP=1
- +1 SET ZTIO=""
- SET ZTQUEUED=1
- +2 SET BGUARRAY="^XTMP(""BPCRPT"","_$JOB_")"
- +3 IF $GET(BPCBD)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"
- DO KILL
- QUIT
- +4 DO DT^DILF("X",BPCBD,.AMHBD)
- +5 IF $GET(AMHBD)=-1
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"
- DO KILL
- QUIT
- +6 IF $GET(BPCED)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"
- DO KILL
- QUIT
- +7 DO DT^DILF("X",BPCED,.AMHED)
- +8 IF $GET(AMHED)=-1
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"
- DO KILL
- QUIT
- +9 IF $GET(BPCOA)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="All or One variable not passed"
- DO KILL
- QUIT
- +10 IF "OA"'[BPCOA
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="All or One variable not passed as O or A"
- DO KILL
- QUIT
- +11 SET AMHOA=BPCOA
- +12 IF AMHOA="O"
- IF $GET(BPCTHER)=""
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="One provider parameter set, provider not defined"
- DO KILL
- QUIT
- +13 IF AMHOA="O"
- IF '$DATA(^VA(200,BPCTHER,0))
- SET ^XTMP("BPCRPT",JOB,.5)=2
- SET ^XTMP("BPCRPT",JOB,1)="Provider IEN passed is not valid"
- DO KILL
- QUIT
- +14 SET AMHTHER=$GET(BPCTHER)
- +15 KILL ^XTMP("BPCRPT",JOB)
- +16 SET ^XTMP("BPCRPTRUN",JOB)=""
- +17 DO ^XBKSET
- +18 DO PROC^AMHLETR
- +19 SET ZTRTN="TSK^BPCBHR1"
- SET ZTIO=""
- SET ZTDESC="BPC TP RES REPORT"
- SET ZTSAVE("AMH*")=""
- SET ZTSAVE("JOB")=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +20 FOR I=1:1:120
- IF $GET(^XTMP("BPCRPTRUN",$JOB))="DONE"
- QUIT
- HANG 1
- +21 DO KILL
- +22 QUIT
- +23 ;
- TSK ;
- +1 DO ^XBKSET
- +2 SET ^XTMP("BPCRPTRUN",JOB)="START"
- +3 DO GUIR^XBLM("PRINT^AMHLETR","^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 AMHOA,AMHBT,AMHTOT
- +2 KILL BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +3 DO XIT^AMHLETR
- +4 QUIT