BPCBHRP2.m

BPCBHRP2 ; IHS/OIT/MJL - behavioral health display for GUI ;

 ;;1.5;BPC;;MAY 26, 2005

 ;

 ;

 ;

TEST ;

 D SUICSTND(.RETVAL,"01/01/1900","12/31/2003","")

 Q

SUICSTND(BGUARRAY,BPCBD,BPCED,BPCCOMM) ;EP - BPCBH RPT SUICIDE STANDARD

  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(BPCCOMM),'$D(^AUTTCOM(BPCCOMM,0)) S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid IEN of community entry passed" D KILL Q

 I BPCCOMM S AMHCOMM(BPCCOMM)=""

 K ^XTMP("BPCRPT",JOB)

 S ^XTMP("BPCRPTRUN",JOB)=""

 D ^XBKSET

 S AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"

 D PROC^AMHRPSU1

 S ZTRTN="TSK^BPCBHRP2",ZTIO="",ZTDESC="BPC SUICIDE STANDARD 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^AMHRPSU1","^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 EOJ^AMHRPSU1

 Q

BPCBHRP2  ; IHS/OIT/MJL - behavioral health display for GUI ;

 +1       ;;1.5;BPC;;MAY 26, 2005

 +2       ;

 +3       ;

 +4       ;

TEST      ;

 +1        DO SUICSTND(.RETVAL,"01/01/1900","12/31/2003","")

 +2        QUIT 

SUICSTND(BGUARRAY,BPCBD,BPCED,BPCCOMM) ;EP - BPCBH RPT SUICIDE STANDARD

 +1        SET JOB=$JOB

           SET BPCGUI=1

           SET XWBWRAP=1

 +2        SET ZTIO=""

           SET ZTQUEUED=1

 +3        SET BGUARRAY="^XTMP(""BPCRPT"","_$JOB_")"

 +4        IF $GET(BPCBD)=""

               SET ^XTMP("BPCRPT",JOB,.5)=2

               SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"

               DO KILL

               QUIT 

 +5        DO DT^DILF("X",BPCBD,.AMHBD)

 +6        IF $GET(AMHBD)=-1

               SET ^XTMP("BPCRPT",JOB,.5)=2

               SET ^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed"

               DO KILL

               QUIT 

 +7        IF $GET(BPCED)=""

               SET ^XTMP("BPCRPT",JOB,.5)=2

               SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"

               DO KILL

               QUIT 

 +8        DO DT^DILF("X",BPCED,.AMHED)

 +9        IF $GET(AMHED)=-1

               SET ^XTMP("BPCRPT",JOB,.5)=2

               SET ^XTMP("BPCRPT",JOB,1)="Invalid ending date passed"

               DO KILL

               QUIT 

 +10       IF $GET(BPCCOMM)

               IF '$DATA(^AUTTCOM(BPCCOMM,0))

                   SET ^XTMP("BPCRPT",JOB,.5)=2

                   SET ^XTMP("BPCRPT",JOB,1)="Invalid IEN of community entry passed"

                   DO KILL

                   QUIT 

 +11       IF BPCCOMM

               SET AMHCOMM(BPCCOMM)=""

 +12       KILL ^XTMP("BPCRPT",JOB)

 +13       SET ^XTMP("BPCRPTRUN",JOB)=""

 +14       DO ^XBKSET

 +15       SET AMHSD=$$FMADD^XLFDT(AMHBD,-1)_".9999"

 +16       DO PROC^AMHRPSU1

 +17       SET ZTRTN="TSK^BPCBHRP2"

           SET ZTIO=""

           SET ZTDESC="BPC SUICIDE STANDARD REPORT"

           SET ZTSAVE("AMH*")=""

           SET ZTSAVE("JOB")=""

           SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

 +18       FOR I=1:1:120

               IF $GET(^XTMP("BPCRPTRUN",$JOB))="DONE"

                   QUIT 

               HANG 1

 +19       DO KILL

 +20       QUIT 

 +21      ;

TSK       ;

 +1        DO ^XBKSET

 +2        SET ^XTMP("BPCRPTRUN",JOB)="START"

 +3        DO GUIR^XBLM("PRINT^AMHRPSU1","^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 EOJ^AMHRPSU1

 +4        QUIT