BPCBHRP4.m

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

 ;;1.5;BPC;;MAY 26, 2005

 ;

 ;

 ;

TEST ;

 D DISPLAST(.RETVAL,1,,"S")

 Q

DISPLAST(BGUARRAY,BPCPAT,BPCPROV,BPCTYPE,BPCEFT) ;EP - BPCBH RPT LAST VISIT

 NEW AMHR

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

 S ZTIO="",ZTQUEUED=1

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

 K ^XTMP("BPCRPT",JOB)

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

 I $G(BPCTYPE)="" S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid format type passed" D KILL Q

 I "ES"'[BPCTYPE S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid format type passed" D KILL Q

 I $G(BPCPROV),'$D(^VA(200,BPCPROV,0)) S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="Invalid IEN of provider entry passed" D KILL Q

 S AMHLVPR=$G(BPCPROV)

 S AMHTYPE=$G(BPCTYPE)

 S (DFN,AMHPAT,AUPNPAT)=BPCPAT

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

 D ^XBKSET

 D GETREC

 I 'AMHR S ^XTMP("BPCRPT",JOB,.5)=2,^XTMP("BPCRPT",JOB,1)="No visit found" D KILL Q

 S ZTRTN="TSK^BPCBHRP4",ZTIO="",ZTDESC="BPC LAST VISIT DISPLAY",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD

 F I=1:1:120 Q:$G(^XTMP("BPCRPTRUN",$J))="DONE"  H 1

 D KILL

 Q

 ;

GETREC ;

 S AMHR="",AMHEFT=$G(BPCEFT) I AMHEFT="" S AMHEFT="F"

 I '$D(^AMHREC("AE",AMHPAT)) Q

 I AMHLVPR="" S AMHDLAST=$O(^AMHREC("AE",AMHPAT,"")),AMHR=$O(^AMHREC("AE",AMHPAT,AMHDLAST,"")) Q

 NEW D,%,P S (D,%)="" F  S D=$O(^AMHREC("AE",AMHPAT,D)) Q:D'=+D!(AMHR)  D

 .S V=0 F  S V=$O(^AMHREC("AE",AMHPAT,D,V)) Q:V'=+V  I $$PPINT^AMHUTIL(V)=AMHLVPR S AMHR=V

 .Q

 Q

TSK ;

 D ^XBKSET

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

 D GUIR^XBLM($S(AMHTYPE="S":"EN1^AMHLELV",1:"^AMHLEFP2"),"^XTMP(""BPCRPT"",JOB)")

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

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

 Q

 ;

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

 Q

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

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

 +2       ;

 +3       ;

 +4       ;

TEST      ;

 +1        DO DISPLAST(.RETVAL,1,,"S")

 +2        QUIT 

DISPLAST(BGUARRAY,BPCPAT,BPCPROV,BPCTYPE,BPCEFT) ;EP - BPCBH RPT LAST VISIT

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

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

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

               DO KILL

               QUIT 

 +7        IF $GET(BPCTYPE)=""

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

               SET ^XTMP("BPCRPT",JOB,1)="Invalid format type passed"

               DO KILL

               QUIT 

 +8        IF "ES"'[BPCTYPE

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

               SET ^XTMP("BPCRPT",JOB,1)="Invalid format type passed"

               DO KILL

               QUIT 

 +9        IF $GET(BPCPROV)

               IF '$DATA(^VA(200,BPCPROV,0))

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

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

                   DO KILL

                   QUIT 

 +10       SET AMHLVPR=$GET(BPCPROV)

 +11       SET AMHTYPE=$GET(BPCTYPE)

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

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

 +14       DO ^XBKSET

 +15       DO GETREC

 +16       IF 'AMHR

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

               SET ^XTMP("BPCRPT",JOB,1)="No visit found"

               DO KILL

               QUIT 

 +17       SET ZTRTN="TSK^BPCBHRP4"

           SET ZTIO=""

           SET ZTDESC="BPC LAST VISIT DISPLAY"

           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      ;

GETREC    ;

 +1        SET AMHR=""

           SET AMHEFT=$GET(BPCEFT)

           IF AMHEFT=""

               SET AMHEFT="F"

 +2        IF '$DATA(^AMHREC("AE",AMHPAT))

               QUIT 

 +3        IF AMHLVPR=""

               SET AMHDLAST=$ORDER(^AMHREC("AE",AMHPAT,""))

               SET AMHR=$ORDER(^AMHREC("AE",AMHPAT,AMHDLAST,""))

               QUIT 

 +4        NEW D,%,P

           SET (D,%)=""

           FOR 

               SET D=$ORDER(^AMHREC("AE",AMHPAT,D))

               IF D'=+D!(AMHR)

                   QUIT 

               Begin DoDot:1

 +5                SET V=0

                   FOR 

                       SET V=$ORDER(^AMHREC("AE",AMHPAT,D,V))

                       IF V'=+V

                           QUIT 

                       IF $$PPINT^AMHUTIL(V)=AMHLVPR

                           SET AMHR=V

 +6                QUIT 

               End DoDot:1

 +7        QUIT 

TSK       ;

 +1        DO ^XBKSET

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

 +3        DO GUIR^XBLM($SELECT(AMHTYPE="S":"EN1^AMHLELV",1:"^AMHLEFP2"),"^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