AMHBHRP5.m

AMHBHRP5 ; IHS/CMI/LAB - behavioral health display for GUI ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;

 ;

TEST ;

 D DISPLAST(.RETVAL,40503,"D",,"01/01/1995","01/20/2005")

 Q

DISPLAST(AMHARRAY,AMHPAT,AMHTYPE,AMHNUM,AMHBD,AMHED,AMHPROG) ;EP - AMHBH RPT LAST VISIT

 NEW AMHR

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

 S ZTIO="",ZTQUEUED=1

 S AMHARRAY="^XTMP(""AMHRPT"","_$J_")"

 K ^XTMP("AMHRPT",$J)

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

 I $G(AMHTYPE)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid type of report type passed" D KILL Q

 I "LNADPS"'[AMHTYPE S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid report type passed" D KILL Q

 I $G(AMHTYPE)="N",$G(AMHNUM)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Number of visits not passed for N type" D KILL Q

 I $G(AMHTYPE)="D",$G(AMHBD)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Beginning date not passed and type is date range" D KILL Q

 I AMHBD]"" D DT^DILF("X",AMHBD,.AMHBD) I $G(AMHBD)=-1 S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid beginning date passed" D KILL Q

 I $G(AMHTYPE)="D",$G(AMHED)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Ending date not passed and type is date range" D KILL Q

 I AMHED]"" D DT^DILF("X",AMHED,.AMHED) I $G(AMHED)=-1 S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Invalid ending date passed" D KILL Q

 I $G(AMHTYPE)="P",$G(AMHPROG)="" S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="Program type not passed and type is program" D KILL Q

 S (DFN,AMHPAT,AUPNPAT)=AMHPAT

 K AMHV D @AMHTYPE

 I '$O(AMHV(0)) S ^XTMP("AMHRPT",JOB,.5)=2,^XTMP("AMHRPT",JOB,1)="No visits found"  ;cmi/maw 4/5/2010 PR 682 D KILL Q

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

 D ^XBKSET

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

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

 D TSK

 D KILL

 Q

 ;

TSK ;

 D ^XBKSET

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

 D GUIR^XBLM("PRINT^AMHVD","^XTMP(""AMHRPT"",JOB)")

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

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

 Q

 ;

KILL ;

 K DFN,AMHPAT,AUPNPAT

 K AMHOA,AMHBT,AMHTOT

 K AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE

 ;D EN^XBVK("AMH")

 Q

L ;get patients last visit

 ;AMHV array

 S (C,D)=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!(C>0)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C>0)  I $$ALLOWVI^AMHUTIL(DUZ,V) S C=C+1,AMHV(D,V)=""

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

 ;S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))

 ;I R S AMHV(D,R)=""

 Q

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",$$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""

 Q

N ;patients last N visits

 S (C,D)=0 F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!(C=AMHNUM)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V!(C=AMHNUM)  I $$ALLOWVI^AMHUTIL(DUZ,V) S C=C+1,AMHV(D,V)=""

 Q

P ;on program

 S D=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,2)=AMHPROG,$$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""

 Q

A ;all visits

 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 $$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""

 Q

D ;date rante

 S E=9999999-AMHBD,D=9999999-AMHED-1_".99" F  S D=$O(^AMHREC("AE",DFN,D)) Q:D'=+D!($P(D,".")>E)  S V=0 F  S V=$O(^AMHREC("AE",DFN,D,V)) Q:V'=+V  I $$ALLOWVI^AMHUTIL(DUZ,V) S AMHV(D,V)=""

 Q

AMHBHRP5  ; IHS/CMI/LAB - behavioral health display for GUI ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

 +4       ;

TEST      ;

 +1        DO DISPLAST(.RETVAL,40503,"D",,"01/01/1995","01/20/2005")

 +2        QUIT 

DISPLAST(AMHARRAY,AMHPAT,AMHTYPE,AMHNUM,AMHBD,AMHED,AMHPROG) ;EP - AMHBH RPT LAST VISIT

 +1        NEW AMHR

 +2        SET JOB=$JOB

           SET AMHGUI=1

           SET XWBWRAP=1

 +3        SET ZTIO=""

           SET ZTQUEUED=1

 +4        SET AMHARRAY="^XTMP(""AMHRPT"","_$JOB_")"

 +5        KILL ^XTMP("AMHRPT",$JOB)

 +6        IF $GET(AMHPAT)=""

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

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

               DO KILL

               QUIT 

 +7        IF $GET(AMHTYPE)=""

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

               SET ^XTMP("AMHRPT",JOB,1)="Invalid type of report type passed"

               DO KILL

               QUIT 

 +8        IF "LNADPS"'[AMHTYPE

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

               SET ^XTMP("AMHRPT",JOB,1)="Invalid report type passed"

               DO KILL

               QUIT 

 +9        IF $GET(AMHTYPE)="N"

               IF $GET(AMHNUM)=""

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

                   SET ^XTMP("AMHRPT",JOB,1)="Number of visits not passed for N type"

                   DO KILL

                   QUIT 

 +10       IF $GET(AMHTYPE)="D"

               IF $GET(AMHBD)=""

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

                   SET ^XTMP("AMHRPT",JOB,1)="Beginning date not passed and type is date range"

                   DO KILL

                   QUIT 

 +11       IF AMHBD]""

               DO DT^DILF("X",AMHBD,.AMHBD)

               IF $GET(AMHBD)=-1

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

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

                   DO KILL

                   QUIT 

 +12       IF $GET(AMHTYPE)="D"

               IF $GET(AMHED)=""

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

                   SET ^XTMP("AMHRPT",JOB,1)="Ending date not passed and type is date range"

                   DO KILL

                   QUIT 

 +13       IF AMHED]""

               DO DT^DILF("X",AMHED,.AMHED)

               IF $GET(AMHED)=-1

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

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

                   DO KILL

                   QUIT 

 +14       IF $GET(AMHTYPE)="P"

               IF $GET(AMHPROG)=""

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

                   SET ^XTMP("AMHRPT",JOB,1)="Program type not passed and type is program"

                   DO KILL

                   QUIT 

 +15       SET (DFN,AMHPAT,AUPNPAT)=AMHPAT

 +16       KILL AMHV

           DO @AMHTYPE

 +17      ;cmi/maw 4/5/2010 PR 682 D KILL Q

           IF '$ORDER(AMHV(0))

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

               SET ^XTMP("AMHRPT",JOB,1)="No visits found"

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

 +19       DO ^XBKSET

 +20      ;S ZTRTN="TSK^AMHBHRP5",ZTIO="",ZTDESC="AMH LAST VISIT DISPLAY",ZTSAVE("DFN")="",ZTSAVE("AMH*")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD

 +21      ;F I=1:1:120 Q:$G(^XTMP("AMHRPTRUN",$J))="DONE"  H 1

 +22       DO TSK

 +23       DO KILL

 +24       QUIT 

 +25      ;

TSK       ;

 +1        DO ^XBKSET

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

 +3        DO GUIR^XBLM("PRINT^AMHVD","^XTMP(""AMHRPT"",JOB)")

 +4        SET ^XTMP("AMHRPT",JOB,.5)=$ORDER(^XTMP("AMHRPT",JOB,""),-1)+1

 +5        SET ^XTMP("AMHRPTRUN",JOB)="DONE"

 +6        QUIT 

 +7       ;

KILL      ;

 +1        KILL DFN,AMHPAT,AUPNPAT

 +2        KILL AMHOA,AMHBT,AMHTOT

 +3        KILL AMHCTR,AMHGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE

 +4       ;D EN^XBVK("AMH")

 +5        QUIT 

L         ;get patients last visit

 +1       ;AMHV array

 +2        SET (C,D)=0

           FOR 

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

               IF D'=+D!(C>0)

                   QUIT 

               SET V=0

               FOR 

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

                   IF V'=+V!(C>0)

                       QUIT 

                   IF $$ALLOWVI^AMHUTIL(DUZ,V)

                       SET C=C+1

                       SET AMHV(D,V)=""

 +3       ;I '$D(^AMHREC("AE",DFN)) Q

 +4       ;S D=$O(^AMHREC("AE",DFN,"")),R=$O(^AMHREC("AE",DFN,D,""))

 +5       ;I R S AMHV(D,R)=""

 +6        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"

                       IF $$ALLOWVI^AMHUTIL(DUZ,V)

                           SET AMHV(D,V)=""

 +3        QUIT 

N         ;patients last N visits

 +1        SET (C,D)=0

           FOR 

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

               IF D'=+D!(C=AMHNUM)

                   QUIT 

               SET V=0

               FOR 

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

                   IF V'=+V!(C=AMHNUM)

                       QUIT 

                   IF $$ALLOWVI^AMHUTIL(DUZ,V)

                       SET C=C+1

                       SET AMHV(D,V)=""

 +2        QUIT 

P         ;on program

 +1        SET D=0

           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,2)=AMHPROG

                       IF $$ALLOWVI^AMHUTIL(DUZ,V)

                           SET AMHV(D,V)=""

 +2        QUIT 

A         ;all visits

 +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 $$ALLOWVI^AMHUTIL(DUZ,V)

                       SET AMHV(D,V)=""

 +3        QUIT 

D         ;date rante

 +1        SET E=9999999-AMHBD

           SET D=9999999-AMHED-1_".99"

           FOR 

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

               IF D'=+D!($PIECE(D,".")>E)

                   QUIT 

               SET V=0

               FOR 

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

                   IF V'=+V

                       QUIT 

                   IF $$ALLOWVI^AMHUTIL(DUZ,V)

                       SET AMHV(D,V)=""

 +2        QUIT