Routine: BPCBHRP9

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

 ;;1.5;BPC;;MAY 26, 2005

TEST ;

 D NOSHOW(.RETVAL,87,"01/01/1995","01/20/2003")

NOSHOW(BGUARRAY,BPCPAT,BPCBD,BPCED,BPCPROG) ;EP - BPCBH RPT LIST NO SHOWS 1 PAT

 NEW AMHR

 S JOB=$J,BPCGUI=1,XWBWRAP=1

 S ZTIO="",ZTQUEUED=1

 S BGUARRAY="^XTMP(""BPCRPT"","_$J_")"

 K ^XTMP("BPCRPT",$J)

 I $G(BPCPROG)="" S BPCPROG="A"

 S AMHPROG=BPCPROG

 I $G(BPCPAT)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid DFN of patient passed" D KILL Q

 I $G(BPCBD)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid beginning date passed" 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(BPCED)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid ending date passed" 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

 S (DFN,AMHPAT,AUPNPAT)=BPCPAT

 S AMHBDD=$$FMTE^XLFDT(AMHBD)

 S AMHEDD=$$FMTE^XLFDT(AMHED)

 D PROC^AMHRNS

 K ^XTMP("BPCRPT",JOB)

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

 D ^XBKSET

 S ZTRTN="TSK^BPCBHRP9",ZTIO="",ZTDESC="BPC LIST NO SHOW",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

TSK ;

 D ^XBKSET

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

 D GUIR^XBLM("PRINT^AMHRNS","^XTMP(""BPCRPT"",JOB)")

 S ^XTMP("BPCRPT",JOB,.5)=$O(^XTMP("BPCRPT",JOB,""),-1)+1

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

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")

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)=""

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)=""

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

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

 +2       ;

 +3       ;

 +4       ;

TEST      ;

 +1        DO NOSHOW(.RETVAL,87,"01/01/1995","01/20/2003")

 +2        QUIT

NOSHOW(BGUARRAY,BPCPAT,BPCBD,BPCED,BPCPROG) ;EP - BPCBH RPT LIST NO SHOWS 1 PAT

 +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(BPCPROG)=""

               SET BPCPROG="A"

 +7        SET AMHPROG=BPCPROG

 +8        IF $GET(BPCPAT)=""

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

               SET ^XTMP("BPCRPT",JOB,1)="Invalid DFN of patient passed"

               DO KILL

               QUIT

 +9        IF $GET(BPCBD)=""

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

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

               DO KILL

               QUIT

 +10       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

 +11       IF $GET(BPCED)=""

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

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

               DO KILL

               QUIT

 +12       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

 +13       SET (DFN,AMHPAT,AUPNPAT)=BPCPAT

 +14       SET AMHBDD=$$FMTE^XLFDT(AMHBD)

 +15       SET AMHEDD=$$FMTE^XLFDT(AMHED)

 +16       DO PROC^AMHRNS

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

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

 +19       DO ^XBKSET

 +20       SET ZTRTN="TSK^BPCBHRP9"

           SET ZTIO=""

           SET ZTDESC="BPC LIST NO SHOW"

           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^AMHRNS","^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

BPCBHRP9.m