AMHGR.m

AMHGR ; IHS/CMI/MAW - AMH Behavioral Health GUI Reports 9/30/2008 3:29:28 PM ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2**;JUN 18, 2010;Build 23

 ;

 ;

 ;

 ;

 ;

DEBUG(AMHRET,AMHSTR) ;-- debugger

 D DEBUG^%Serenji("INTAKE^AMHGR(.AMHRET,.AMHSTR)")

 Q

 ;

HS(RETVAL,AMHSTR) ;-- get health summary data from BPC

 D ADO^AMHGU

 N AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,P,AMHERR

 S P="|"

 S APCHSPAT=$P(AMHSTR,P)

 S APCHSTYP=$P(AMHSTR,P,2)

 I APCHSTYP'?.N S APCHSTYP=$O(^APCHSCTL("B",APCHSTYP,0))

 S AMHI=0

 S @RETVAL@(AMHI)="T00080DATA"_$C(30)

 S IOM=80

 D GUIR^XBLM("EN^APCHS","^XTMP(""AMHHS"",$J)")

 ;D CAPTURE^CIAUHFS("D EN^APCHS","^XTMP(""AMHHS"",$J)",80)

 I '$D(^XTMP("AMHHS",$J)) D  Q

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)="NO DATA"_$C(30)

 . S @RETVAL@(AMHI+1)=$C(31)

 S AMHDA=.5 F  S AMHDA=$O(^XTMP("AMHHS",$J,AMHDA)) Q:'AMHDA  D

 . N AMHDATA

 . S AMHI=AMHI+1

 . S AMHDATA=$G(^XTMP("AMHHS",$J,AMHDA))

 . S @RETVAL@(AMHI)=AMHDATA_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHHS",$J),DFN,APCHSPAT,APCHSTYP,AMHGUI,Y,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

FS(RETVAL,AMHSTR) ;-- return patient reg face sheet

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N P,DFN,AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHERR

 S P="|"

 S DFN=$P(AMHSTR,P)

 S AMHI=0

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S @RETVAL@(AMHI)="T00250DATA"_$C(30)

 S IOM=80

 D GUIR^XBLM("START^AGFACE","^XTMP(""AMHFS"",$J)")

 ;D CAPTURE^CIAUHFS("D START^AGFACE","^XTMP(""AMHFS"",$J)",80)

 I '$D(^XTMP("AMHFS",$J)) D  Q

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)="NO DATA"_$C(30)

 . S @RETVAL@(AMHI+1)=$C(31)

 S AMHDA=.5 F  S AMHDA=$O(^XTMP("AMHFS",$J,AMHDA)) Q:'AMHDA  D

 . N AMHDATA

 . S AMHI=AMHI+1

 . S AMHDATA=$G(^XTMP("AMHFS",$J,AMHDA))

 . S @RETVAL@(AMHI)=AMHDATA_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHFS",$J),DFN,AGOPT,AMHGUI,AGDENT,Y,AGMVDF,AMHAL,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

INTAKE(RETVAL,AMHSTR) ;-- get intake display

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N P,AMHREC,AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHUPS,AMHTYP

 S P="|"

 S AMHUPS=""

 S AMHTYP=$P(AMHSTR,P)

 S AMHPAT=$P(AMHSTR,P,2)

 S AMHREC=$P(AMHSTR,P,3)

 S AMHI=0

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S @RETVAL@(AMHI)="T00250DATA"_$C(30)

 S IOM=80

 K DFN

 I $P(AMHSTR,P,4)]"" D

 . N I,AMHUP,R

 . S R="~"

 . S AMHUP=$P(AMHSTR,P,4)

 . F I=1:1 D  Q:$P(AMHUP,R,I)=""

 .. Q:$P(AMHUP,R,I)=""

 .. S AMHUPS($P(AMHUP,R,I))=""

 D GUI^AMHLEIV3(AMHTYP,AMHPAT,AMHREC,.AMHUPS,"^XTMP(""AMHITK"",$J)")

 I '$D(^XTMP("AMHITK",$J)) D  Q

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)="NO DATA"_$C(30)

 . S @RETVAL@(AMHI+1)=$C(31)

 S AMHDA=.5 F  S AMHDA=$O(^XTMP("AMHITK",$J,AMHDA)) Q:'AMHDA  D

 . N AMHDATA

 . S AMHI=AMHI+1

 . S AMHDATA=$G(^XTMP("AMHITK",$J,AMHDA))

 . Q:AMHDATA=$C(10)  ;cmi/maw 1/13/10 pr593

 . S @RETVAL@(AMHI)=AMHDATA_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHITK",$J),DFN,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

BHREC(RETVAL,AMHSTR) ;-- get a viewable display of the Mental Health Encounter out of ^AMHREC

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,AMHIEN,P

 S P="|"

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 S AMHIEN=$P(AMHSTR,P)

 K DFN

 D NRECDISP^AMHBHDSP(.RETTMP,AMHIEN)

 N AMHDA

 S AMHDA=.5 F  S AMHDA=$O(@RETTMP@(AMHDA)) Q:'AMHDA  D

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)=$G(@RETTMP@(AMHDA))_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^TMP("AMHVDSG",$J),DFN,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

PCC(RETVAL,AMHSTR) ;-- display pcc visit

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHVIEN,P

 S P="|"

 S AMHVIEN=$P(AMHSTR,P)

 S AMHI=0

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S @RETVAL@(AMHI)="T00250Data"_$C(30)

 N AMHGUI

 S AMHGUI=1

 K DFN

 D EN^APCDVDSG(AMHVIEN,"^XTMP(""AMHLV"",$J)",AMHGUI)

 I '$D(^XTMP("AMHLV",$J)) D  Q

 . S AMHI=AMHI+1

 . S ^AMHTMP($J,AMHI)="NO DATA"_$C(30)

 . S ^AMHTMP($J,AMHI+1)=$C(31)

 S AMHDA=0 F  S AMHDA=$O(^XTMP("AMHLV",$J,AMHDA)) Q:'AMHDA  D

 . N AMHDATA

 . S AMHI=AMHI+1

 . S AMHDATA=$G(^XTMP("AMHLV",$J,AMHDA,0))

 . S @RETVAL@(AMHI)=AMHDATA_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHLV",$J),DFN,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

BROWSE(RETVAL,AMHSTR) ;-- call the browse visits RPC

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHOPT,AMHN,AMHBD,AMHED,AMHPRG,AMHPAT

 S P="|"

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 S AMHOPT=$P(AMHSTR,P)

 S AMHN=$P(AMHSTR,P,2)

 S AMHBD=$P(AMHSTR,P,3)

 S AMHED=$P(AMHSTR,P,4)

 S AMHPRG=$P(AMHSTR,P,5)

 S AMHPAT=$P(AMHSTR,P,6)

 K RETTMP,DFN

 D DISPLAST^AMHBHRP5(.RETTMP,AMHPAT,AMHOPT,AMHN,AMHBD,AMHED,AMHPRG)

 N AMHDA

 S AMHDA=.5 F  S AMHDA=$O(@RETTMP@(AMHDA)) Q:'AMHDA  D

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)=$G(@RETTMP@(AMHDA))_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHRPT",$J),DFN,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

EF(RETVAL,AMHSTR) ;-- call the encounter form display

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHREC,AMHFORM

 S P="|"

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 S AMHREC=$P(AMHSTR,P)

 S AMHFORM=$P(AMHSTR,P,2)

 K RETTMP,DFN

 D ENCFORM^AMHBHDSP(.RETTMP,AMHREC,AMHFORM)

 S RETTMP="^XTMP(""AMHGEF"",$J)"

 N AMHDA

 S AMHDA=.5 F  S AMHDA=$O(@RETTMP@(AMHDA)) Q:'AMHDA  D

 . S AMHI=AMHI+1

 . Q:$G(@RETTMP@(AMHDA))=$C(10)  ;cmi/maw 1/13/10 pr593

 . S @RETVAL@(AMHI)=$G(@RETTMP@(AMHDA))_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^TMP("AMHS",$J,"DCS"),DFN,ZTQUEUED,ZTIO,AMHZ

 K ^XTMP("AMHGEF",$J)

 Q

 ;

EFG(RETVAL,AMHSTR) ;-- call the encounter form display group

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHREC,AMHFORM,R,AMHRRY,I

 S P="|",R="~"

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 S AMHREC=$P(AMHSTR,P)

 S AMHFORM=$P(AMHSTR,P,2)

 K RETTMP,DFN

 N AMHDA

 S I=0

 S AMHDA=0 F  S AMHDA=$O(^AMHGROUP(AMHREC,61,AMHDA)) Q:'AMHDA  D

 . S I=I+1

 . S AMHRECI=$G(^AMHGROUP(AMHREC,61,AMHDA,0))

 . S AMHRRY("RECS ADDED",I)=AMHRECI

 D GUI^AMHLEGPP(.RETTMP,.AMHRRY,AMHFORM,AMHFORM)

 N AMHDA

 S AMHDA=.5 F  S AMHDA=$O(@RETTMP@(AMHDA)) Q:'AMHDA  D

 . S AMHI=AMHI+1

 . N AMHDATA

 . S AMHDATA=$G(@RETTMP@(AMHDA))

 . ;I AMHDATA="ZZZZZZZ" S AMHDATA=$C(12)

 . Q:$G(AMHDATA)=$C(10)  ;cmi/maw 1/13/10 pr593

 . S @RETVAL@(AMHI)=AMHDATA_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^TMP($J,"AMHGROUP"),DFN,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

SF(RETVAL,AMHSTR) ;-- call the suicide form display

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHREC,AMHERR

 S P="|"

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 S AMHREC=$P(AMHSTR,P)

 K RETTMP,DFN

 D SUICDSP^AMHBHDSP(.RETTMP,AMHREC)

 N AMHDA

 S AMHDA=.5 F  S AMHDA=$O(@RETTMP@(AMHDA)) Q:'AMHDA  D

 . S AMHI=AMHI+1

 . Q:$G(@RETTMP@(AMHDA))=$C(10)  ;cmi/maw 1/13/10 pr593

 . S @RETVAL@(AMHI)=$G(@RETTMP@(AMHDA))_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHSF",$J),DFN,AMHGUI,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

TP(RETVAL,AMHSTR) ;-- print treatment plan

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHREC,AMHTYP,AMHREV,AMHRP

 S P="|"

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 S AMHREC=$P(AMHSTR,P)

 S AMHTYP=$P(AMHSTR,P,2)

 S AMHREV=$P(AMHSTR,P,3)

 S AMHRP=""

 I $G(AMHREV)]"" D

 . F I=1:1 D  Q:$P(AMHREV,"~",I)=""

 .. Q:$P(AMHREV,"~",I)=""

 .. N AMHR

 .. S AMHR=$P(AMHREV,"~",I)

 .. S AMHRP(AMHR)=""

 K RETTMP,DFN

 D TPP^AMHBHTPP(.RETTMP,AMHREC,AMHTYP,.AMHRP)

 N AMHDA

 S AMHDA=.5 F  S AMHDA=$O(@RETTMP@(AMHDA)) Q:'AMHDA  D

 . S AMHI=AMHI+1

 . Q:$G(@RETTMP@(AMHDA))=$C(10)  ;cmi/maw 1/13/10 pr593

 . S @RETVAL@(AMHI)=$G(@RETTMP@(AMHDA))_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^XTMP("AMHTP",$J),DFN,ZTQUEUED,ZTIO,AMHZ

 Q

 ;

PCCM(RETVAL,AMHSTR) ;-- get pcc medication listing

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHP,AMHB,AMHE

 S P="|"

 S AMHP=$P(AMHSTR,P,3)

 S AMHB=$P(AMHSTR,P)

 S AMHE=$P(AMHSTR,P,2)

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 D PCCM^AMHGRU(AMHP,AMHB,AMHE)

 N AMHDA,AMHDATA

 S AMHDA=0 F  S AMHDA=$O(^TMP("AMHDSPMEDS",$J,AMHDA)) Q:'AMHDA  D

 . S AMHDATA=$G(^TMP("AMHDSPMEDS",$J,AMHDA,0))

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)=$G(AMHDATA)_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^TMP("AMHDSPMEDS",$J)

 Q

 ;

APPT(RETVAL,AMHSTR) ;-- get patient appointments

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHP,AMHB,AMHE,HDR

 S P="|"

 S AMHP=$P(AMHSTR,P,3)

 S AMHB=$P(AMHSTR,P)

 S AMHE=$P(AMHSTR,P,2)

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 D INIT^AMHGRAP(AMHP,AMHB,AMHE)

 K ^TMP("AMHDPA",$J,"IDX")

 N AMHDA,AMHDATA

 S AMHDA=0 F  S AMHDA=$O(^TMP("AMHDPA",$J,AMHDA)) Q:'AMHDA  D

 . S AMHDATA=$G(^TMP("AMHDPA",$J,AMHDA,0))

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)=$G(AMHDATA)_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^TMP("AMHDPA",$J)

 D EXIT^AMHGRAP

 Q

 ;

PCCL(RETVAL,AMHSTR) ;-- get pcc labs

 S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap

 N AMHI,P,AMHP,AMHB,AMHE

 S P="|"

 S AMHP=$P(AMHSTR,P,3)

 S AMHB=$P(AMHSTR,P)

 S AMHE=$P(AMHSTR,P,2)

 S AMHDM=$P(AMHSTR,P,4)

 K ^AMHTMP($J)

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 I AMHDM="G" S ^AMHTMP($J,AMHI)="T00010Lab Test IEN^T00040Lab Test^T00010Count^T00030Earliest Test^T00030Latest Test"_$C(30)

 I AMHDM="V"!(AMHDM="DV") S ^AMHTMP($J,AMHI)="T00250Data"_$C(30)

 D PCCL^AMHGRU(AMHP,AMHB,AMHE,AMHDM)

 N AMHDA,AMHDATA,AMHIEN,AMHVST,AMHRES,AMHABN,AMHRL,AMHRH,AMHOP,AMHTSI,AMHCNT,AMHEARLY,AMHLAST,AMHCDT

 I AMHDM="G" D

 . S AMHDA=0 F  S AMHDA=$O(^TMP("AMHLABG",$J,AMHDA)) Q:AMHDA=""  D

 .. S AMHDATA=$G(^TMP("AMHLABG",$J,AMHDA))

 .. S AMHTSI=$P(AMHDATA,U)

 .. S AMHCNT=$P(AMHDATA,U,2)

 .. S AMHEARLY=$P(AMHDATA,U,3)

 .. S AMHLAST=$P(AMHDATA,U,4)

 .. S AMHEARLY=$$LVDT^AMHGU(AMHEARLY)

 .. S AMHLAST=$$LVDT^AMHGU(AMHLAST)

 .. S AMHI=AMHI+1

 .. S @RETVAL@(AMHI)=AMHTSI_U_AMHDA_U_$G(AMHCNT)_U_AMHEARLY_U_AMHLAST_$C(30)

 I AMHDM="V" D

 . S AMHI=AMHI+1

 . S LINE="Collection Date"_$$SP^AMHGRU(9)_"Lab Test"_$$SP^AMHGRU(17)_"Result"_$$SP^AMHGRU(18)_"Abnormal"

 . S @RETVAL@(AMHI)=LINE_$C(30)

 . S AMHI=AMHI+1

 . S LINE="Reference Low"_$$SP^AMHGRU(11)_"Reference High"_$$SP^AMHGRU(11)_"Ordering Provider"

 . S @RETVAL@(AMHI)=LINE_$C(30)

 . S AMHDA=0 F  S AMHDA=$O(^TMP("AMHLABV",$J,AMHDA)) Q:AMHDA=""  D

 .. S AMHIEN=0 F  S AMHIEN=$O(^TMP("AMHLABV",$J,AMHDA,AMHIEN)) Q:AMHIEN=""  D

 ... S AMHDATA=$G(^TMP("AMHLABV",$J,AMHDA,AMHIEN))

 ... S AMHVST=$P(AMHDATA,U)

 ... S AMHRES=$P(AMHDATA,U,2)

 ... S AMHABN=$P(AMHDATA,U,3)

 ... S AMHRL=$P(AMHDATA,U,4)

 ... S AMHRH=$P(AMHDATA,U,5)

 ... S AMHOP=$P(AMHDATA,U,6)

 ... S AMHCDT=$P(AMHDATA,U,7)

 ... S AMHI=AMHI+1

 ... S LINE=$$PAD^AMHGRU(AMHCDT,24)_$$PAD^AMHGRU(AMHIEN,25)_$$PAD^AMHGRU(AMHRES,24)_AMHABN  ;v4.0p1 pr781

 ... S @RETVAL@(AMHI)=LINE_$C(30)

 ... S LINE=$$PAD^AMHGRU(AMHRL,24)_$$PAD^AMHGRU(AMHRH,25)_AMHOP

 ... S AMHI=AMHI+1

 ... S @RETVAL@(AMHI)=LINE_$C(30)

 ... S AMHI=AMHI+1

 ... S @RETVAL@(AMHI)=""_$C(30)

 I AMHDM="DV" D

 . S AMHI=AMHI+1

 . S LINE="Lab Test"_$$SP^AMHGRU(16)_"Collection Date"_$$SP^AMHGRU(10)_"Result"_$$SP^AMHGRU(18)_"Abnormal"

 . S @RETVAL@(AMHI)=LINE_$C(30)

 . S AMHI=AMHI+1

 . S LINE="Reference Low"_$$SP^AMHGRU(11)_"Reference High"_$$SP^AMHGRU(11)_"Ordering Provider"

 . S @RETVAL@(AMHI)=LINE_$C(30)

 . S AMHDA=0 F  S AMHDA=$O(^TMP("AMHLABV",$J,AMHDA)) Q:AMHDA=""  D

 .. S AMHIEN=0 F  S AMHIEN=$O(^TMP("AMHLABV",$J,AMHDA,AMHIEN)) Q:AMHIEN=""  D

 ... S AMHDATA=$G(^TMP("AMHLABV",$J,AMHDA,AMHIEN))

 ... S AMHVST=$P(AMHDATA,U)

 ... S AMHRES=$P(AMHDATA,U,2)

 ... S AMHABN=$P(AMHDATA,U,3)

 ... S AMHRL=$P(AMHDATA,U,4)

 ... S AMHRH=$P(AMHDATA,U,5)

 ... S AMHOP=$P(AMHDATA,U,6)

 ... S AMHCDT=$P(AMHDATA,U,7)

 ... S AMHI=AMHI+1

 ... S LINE=$$PAD^AMHGRU(AMHDA,24)_$$PAD^AMHGRU(AMHCDT,25)_$$PAD^AMHGRU(AMHRES,24)_AMHABN  ;v4.0p1 pr781

 ... S @RETVAL@(AMHI)=LINE_$C(30)

 ... S LINE=$$PAD^AMHGRU(AMHRL,24)_$$PAD^AMHGRU(AMHRH,25)_AMHOP

 ... S AMHI=AMHI+1

 ... S @RETVAL@(AMHI)=LINE_$C(30)

 ... S AMHI=AMHI+1

 ... S @RETVAL@(AMHI)=""_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 K ^TMP("AMHLABG",$J)

 K ^TMP("AMHLABV",$J)

 Q

 ;

AMHGR     ; IHS/CMI/MAW - AMH Behavioral Health GUI Reports 9/30/2008 3:29:28 PM ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1,2**;JUN 18, 2010;Build 23

 +2       ;

 +3       ;

 +4       ;

 +5       ;

 +6       ;

DEBUG(AMHRET,AMHSTR) ;-- debugger

 +1        DO DEBUG^%Serenji("INTAKE^AMHGR(.AMHRET,.AMHSTR)")

 +2        QUIT 

 +3       ;

HS(RETVAL,AMHSTR) ;-- get health summary data from BPC

 +1        DO ADO^AMHGU

 +2        NEW AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,P,AMHERR

 +3        SET P="|"

 +4        SET APCHSPAT=$PIECE(AMHSTR,P)

 +5        SET APCHSTYP=$PIECE(AMHSTR,P,2)

 +6        IF APCHSTYP'?.N

               SET APCHSTYP=$ORDER(^APCHSCTL("B",APCHSTYP,0))

 +7        SET AMHI=0

 +8        SET @RETVAL@(AMHI)="T00080DATA"_$CHAR(30)

 +9        SET IOM=80

 +10       DO GUIR^XBLM("EN^APCHS","^XTMP(""AMHHS"",$J)")

 +11      ;D CAPTURE^CIAUHFS("D EN^APCHS","^XTMP(""AMHHS"",$J)",80)

 +12       IF '$DATA(^XTMP("AMHHS",$JOB))

               Begin DoDot:1

 +13               SET AMHI=AMHI+1

 +14               SET @RETVAL@(AMHI)="NO DATA"_$CHAR(30)

 +15               SET @RETVAL@(AMHI+1)=$CHAR(31)

               End DoDot:1

               QUIT 

 +16       SET AMHDA=.5

           FOR 

               SET AMHDA=$ORDER(^XTMP("AMHHS",$JOB,AMHDA))

               IF 'AMHDA

                   QUIT 

               Begin DoDot:1

 +17               NEW AMHDATA

 +18               SET AMHI=AMHI+1

 +19               SET AMHDATA=$GET(^XTMP("AMHHS",$JOB,AMHDA))

 +20               SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)

               End DoDot:1

 +21       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +22       KILL ^XTMP("AMHHS",$JOB),DFN,APCHSPAT,APCHSTYP,AMHGUI,Y,ZTQUEUED,ZTIO,AMHZ

 +23       QUIT 

 +24      ;

FS(RETVAL,AMHSTR) ;-- return patient reg face sheet

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW P,DFN,AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHERR

 +3        SET P="|"

 +4        SET DFN=$PIECE(AMHSTR,P)

 +5        SET AMHI=0

 +6        KILL ^AMHTMP($JOB)

 +7        SET RETVAL="^AMHTMP("_$JOB_")"

 +8        SET @RETVAL@(AMHI)="T00250DATA"_$CHAR(30)

 +9        SET IOM=80

 +10       DO GUIR^XBLM("START^AGFACE","^XTMP(""AMHFS"",$J)")

 +11      ;D CAPTURE^CIAUHFS("D START^AGFACE","^XTMP(""AMHFS"",$J)",80)

 +12       IF '$DATA(^XTMP("AMHFS",$JOB))

               Begin DoDot:1

 +13               SET AMHI=AMHI+1

 +14               SET @RETVAL@(AMHI)="NO DATA"_$CHAR(30)

 +15               SET @RETVAL@(AMHI+1)=$CHAR(31)

               End DoDot:1

               QUIT 

 +16       SET AMHDA=.5

           FOR 

               SET AMHDA=$ORDER(^XTMP("AMHFS",$JOB,AMHDA))

               IF 'AMHDA

                   QUIT 

               Begin DoDot:1

 +17               NEW AMHDATA

 +18               SET AMHI=AMHI+1

 +19               SET AMHDATA=$GET(^XTMP("AMHFS",$JOB,AMHDA))

 +20               SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)

               End DoDot:1

 +21       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +22       KILL ^XTMP("AMHFS",$JOB),DFN,AGOPT,AMHGUI,AGDENT,Y,AGMVDF,AMHAL,ZTQUEUED,ZTIO,AMHZ

 +23       QUIT 

 +24      ;

INTAKE(RETVAL,AMHSTR) ;-- get intake display

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW P,AMHREC,AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHUPS,AMHTYP

 +3        SET P="|"

 +4        SET AMHUPS=""

 +5        SET AMHTYP=$PIECE(AMHSTR,P)

 +6        SET AMHPAT=$PIECE(AMHSTR,P,2)

 +7        SET AMHREC=$PIECE(AMHSTR,P,3)

 +8        SET AMHI=0

 +9        KILL ^AMHTMP($JOB)

 +10       SET RETVAL="^AMHTMP("_$JOB_")"

 +11       SET @RETVAL@(AMHI)="T00250DATA"_$CHAR(30)

 +12       SET IOM=80

 +13       KILL DFN

 +14       IF $PIECE(AMHSTR,P,4)]""

               Begin DoDot:1

 +15               NEW I,AMHUP,R

 +16               SET R="~"

 +17               SET AMHUP=$PIECE(AMHSTR,P,4)

 +18               FOR I=1:1

                       Begin DoDot:2

 +19                       IF $PIECE(AMHUP,R,I)=""

                               QUIT 

 +20                       SET AMHUPS($PIECE(AMHUP,R,I))=""

                       End DoDot:2

                       IF $PIECE(AMHUP,R,I)=""

                           QUIT 

               End DoDot:1

 +21       DO GUI^AMHLEIV3(AMHTYP,AMHPAT,AMHREC,.AMHUPS,"^XTMP(""AMHITK"",$J)")

 +22       IF '$DATA(^XTMP("AMHITK",$JOB))

               Begin DoDot:1

 +23               SET AMHI=AMHI+1

 +24               SET @RETVAL@(AMHI)="NO DATA"_$CHAR(30)

 +25               SET @RETVAL@(AMHI+1)=$CHAR(31)

               End DoDot:1

               QUIT 

 +26       SET AMHDA=.5

           FOR 

               SET AMHDA=$ORDER(^XTMP("AMHITK",$JOB,AMHDA))

               IF 'AMHDA

                   QUIT 

               Begin DoDot:1

 +27               NEW AMHDATA

 +28               SET AMHI=AMHI+1

 +29               SET AMHDATA=$GET(^XTMP("AMHITK",$JOB,AMHDA))

 +30      ;cmi/maw 1/13/10 pr593

                   IF AMHDATA=$CHAR(10)

                       QUIT 

 +31               SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)

               End DoDot:1

 +32       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +33       KILL ^XTMP("AMHITK",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ

 +34       QUIT 

 +35      ;

BHREC(RETVAL,AMHSTR) ;-- get a viewable display of the Mental Health Encounter out of ^AMHREC

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,AMHIEN,P

 +3        SET P="|"

 +4        KILL ^AMHTMP($JOB)

 +5        SET RETVAL="^AMHTMP("_$JOB_")"

 +6        SET AMHI=0

 +7        SET ^AMHTMP($JOB,AMHI)="T00250Data"_$CHAR(30)

 +8        SET AMHIEN=$PIECE(AMHSTR,P)

 +9        KILL DFN

 +10       DO NRECDISP^AMHBHDSP(.RETTMP,AMHIEN)

 +11       NEW AMHDA

 +12       SET AMHDA=.5

           FOR 

               SET AMHDA=$ORDER(@RETTMP@(AMHDA))

               IF 'AMHDA

                   QUIT 

               Begin DoDot:1

 +13               SET AMHI=AMHI+1

 +14               SET @RETVAL@(AMHI)=$GET(@RETTMP@(AMHDA))_$CHAR(30)

               End DoDot:1

 +15       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +16       KILL ^TMP("AMHVDSG",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ

 +17       QUIT 

 +18      ;

PCC(RETVAL,AMHSTR) ;-- display pcc visit

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHVIEN,P

 +3        SET P="|"

 +4        SET AMHVIEN=$PIECE(AMHSTR,P)

 +5        SET AMHI=0

 +6        KILL ^AMHTMP($JOB)

 +7        SET RETVAL="^AMHTMP("_$JOB_")"

 +8        SET @RETVAL@(AMHI)="T00250Data"_$CHAR(30)

 +9        NEW AMHGUI

 +10       SET AMHGUI=1

 +11       KILL DFN

 +12       DO EN^APCDVDSG(AMHVIEN,"^XTMP(""AMHLV"",$J)",AMHGUI)

 +13       IF '$DATA(^XTMP("AMHLV",$JOB))

               Begin DoDot:1

 +14               SET AMHI=AMHI+1

 +15               SET ^AMHTMP($JOB,AMHI)="NO DATA"_$CHAR(30)

 +16               SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)

               End DoDot:1

               QUIT 

 +17       SET AMHDA=0

           FOR 

               SET AMHDA=$ORDER(^XTMP("AMHLV",$JOB,AMHDA))

               IF 'AMHDA

                   QUIT 

               Begin DoDot:1

 +18               NEW AMHDATA

 +19               SET AMHI=AMHI+1

 +20               SET AMHDATA=$GET(^XTMP("AMHLV",$JOB,AMHDA,0))

 +21               SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)

               End DoDot:1

 +22       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +23       KILL ^XTMP("AMHLV",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ

 +24       QUIT 

 +25      ;

BROWSE(RETVAL,AMHSTR) ;-- call the browse visits RPC

 +1       ; m error trap

           SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")