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")
+2 NEW AMHI,P,AMHOPT,AMHN,AMHBD,AMHED,AMHPRG,AMHPAT
+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 AMHOPT=$PIECE(AMHSTR,P)
+9 SET AMHN=$PIECE(AMHSTR,P,2)
+10 SET AMHBD=$PIECE(AMHSTR,P,3)
+11 SET AMHED=$PIECE(AMHSTR,P,4)
+12 SET AMHPRG=$PIECE(AMHSTR,P,5)
+13 SET AMHPAT=$PIECE(AMHSTR,P,6)
+14 KILL RETTMP,DFN
+15 DO DISPLAST^AMHBHRP5(.RETTMP,AMHPAT,AMHOPT,AMHN,AMHBD,AMHED,AMHPRG)
+16 NEW AMHDA
+17 SET AMHDA=.5
FOR
SET AMHDA=$ORDER(@RETTMP@(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+18 SET AMHI=AMHI+1
+19 SET @RETVAL@(AMHI)=$GET(@RETTMP@(AMHDA))_$CHAR(30)
End DoDot:1
+20 SET @RETVAL@(AMHI+1)=$CHAR(31)
+21 KILL ^XTMP("AMHRPT",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ
+22 QUIT
+23 ;
EF(RETVAL,AMHSTR) ;-- call the encounter form display
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHREC,AMHFORM
+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 AMHREC=$PIECE(AMHSTR,P)
+9 SET AMHFORM=$PIECE(AMHSTR,P,2)
+10 KILL RETTMP,DFN
+11 DO ENCFORM^AMHBHDSP(.RETTMP,AMHREC,AMHFORM)
+12 SET RETTMP="^XTMP(""AMHGEF"",$J)"
+13 NEW AMHDA
+14 SET AMHDA=.5
FOR
SET AMHDA=$ORDER(@RETTMP@(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+15 SET AMHI=AMHI+1
+16 ;cmi/maw 1/13/10 pr593
IF $GET(@RETTMP@(AMHDA))=$CHAR(10)
QUIT
+17 SET @RETVAL@(AMHI)=$GET(@RETTMP@(AMHDA))_$CHAR(30)
End DoDot:1
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 KILL ^TMP("AMHS",$JOB,"DCS"),DFN,ZTQUEUED,ZTIO,AMHZ
+20 KILL ^XTMP("AMHGEF",$JOB)
+21 QUIT
+22 ;
EFG(RETVAL,AMHSTR) ;-- call the encounter form display group
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHREC,AMHFORM,R,AMHRRY,I
+3 SET P="|"
SET R="~"
+4 KILL ^AMHTMP($JOB)
+5 SET RETVAL="^AMHTMP("_$JOB_")"
+6 SET AMHI=0
+7 SET ^AMHTMP($JOB,AMHI)="T00250Data"_$CHAR(30)
+8 SET AMHREC=$PIECE(AMHSTR,P)
+9 SET AMHFORM=$PIECE(AMHSTR,P,2)
+10 KILL RETTMP,DFN
+11 NEW AMHDA
+12 SET I=0
+13 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHGROUP(AMHREC,61,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+14 SET I=I+1
+15 SET AMHRECI=$GET(^AMHGROUP(AMHREC,61,AMHDA,0))
+16 SET AMHRRY("RECS ADDED",I)=AMHRECI
End DoDot:1
+17 DO GUI^AMHLEGPP(.RETTMP,.AMHRRY,AMHFORM,AMHFORM)
+18 NEW AMHDA
+19 SET AMHDA=.5
FOR
SET AMHDA=$ORDER(@RETTMP@(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+20 SET AMHI=AMHI+1
+21 NEW AMHDATA
+22 SET AMHDATA=$GET(@RETTMP@(AMHDA))
+23 ;I AMHDATA="ZZZZZZZ" S AMHDATA=$C(12)
+24 ;cmi/maw 1/13/10 pr593
IF $GET(AMHDATA)=$CHAR(10)
QUIT
+25 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:1
+26 SET @RETVAL@(AMHI+1)=$CHAR(31)
+27 KILL ^TMP($JOB,"AMHGROUP"),DFN,ZTQUEUED,ZTIO,AMHZ
+28 QUIT
+29 ;
SF(RETVAL,AMHSTR) ;-- call the suicide form display
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHREC,AMHERR
+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 AMHREC=$PIECE(AMHSTR,P)
+9 KILL RETTMP,DFN
+10 DO SUICDSP^AMHBHDSP(.RETTMP,AMHREC)
+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 ;cmi/maw 1/13/10 pr593
IF $GET(@RETTMP@(AMHDA))=$CHAR(10)
QUIT
+15 SET @RETVAL@(AMHI)=$GET(@RETTMP@(AMHDA))_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 KILL ^XTMP("AMHSF",$JOB),DFN,AMHGUI,ZTQUEUED,ZTIO,AMHZ
+18 QUIT
+19 ;
TP(RETVAL,AMHSTR) ;-- print treatment plan
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHREC,AMHTYP,AMHREV,AMHRP
+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 AMHREC=$PIECE(AMHSTR,P)
+9 SET AMHTYP=$PIECE(AMHSTR,P,2)
+10 SET AMHREV=$PIECE(AMHSTR,P,3)
+11 SET AMHRP=""
+12 IF $GET(AMHREV)]""
Begin DoDot:1
+13 FOR I=1:1
Begin DoDot:2
+14 IF $PIECE(AMHREV,"~",I)=""
QUIT
+15 NEW AMHR
+16 SET AMHR=$PIECE(AMHREV,"~",I)
+17 SET AMHRP(AMHR)=""
End DoDot:2
IF $PIECE(AMHREV,"~",I)=""
QUIT
End DoDot:1
+18 KILL RETTMP,DFN
+19 DO TPP^AMHBHTPP(.RETTMP,AMHREC,AMHTYP,.AMHRP)
+20 NEW AMHDA
+21 SET AMHDA=.5
FOR
SET AMHDA=$ORDER(@RETTMP@(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+22 SET AMHI=AMHI+1
+23 ;cmi/maw 1/13/10 pr593
IF $GET(@RETTMP@(AMHDA))=$CHAR(10)
QUIT
+24 SET @RETVAL@(AMHI)=$GET(@RETTMP@(AMHDA))_$CHAR(30)
End DoDot:1
+25 SET @RETVAL@(AMHI+1)=$CHAR(31)
+26 KILL ^XTMP("AMHTP",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ
+27 QUIT
+28 ;
PCCM(RETVAL,AMHSTR) ;-- get pcc medication listing
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHP,AMHB,AMHE
+3 SET P="|"
+4 SET AMHP=$PIECE(AMHSTR,P,3)
+5 SET AMHB=$PIECE(AMHSTR,P)
+6 SET AMHE=$PIECE(AMHSTR,P,2)
+7 KILL ^AMHTMP($JOB)
+8 SET RETVAL="^AMHTMP("_$JOB_")"
+9 SET AMHI=0
+10 SET ^AMHTMP($JOB,AMHI)="T00250Data"_$CHAR(30)
+11 DO PCCM^AMHGRU(AMHP,AMHB,AMHE)
+12 NEW AMHDA,AMHDATA
+13 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^TMP("AMHDSPMEDS",$JOB,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+14 SET AMHDATA=$GET(^TMP("AMHDSPMEDS",$JOB,AMHDA,0))
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=$GET(AMHDATA)_$CHAR(30)
End DoDot:1
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 KILL ^TMP("AMHDSPMEDS",$JOB)
+19 QUIT
+20 ;
APPT(RETVAL,AMHSTR) ;-- get patient appointments
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHP,AMHB,AMHE,HDR
+3 SET P="|"
+4 SET AMHP=$PIECE(AMHSTR,P,3)
+5 SET AMHB=$PIECE(AMHSTR,P)
+6 SET AMHE=$PIECE(AMHSTR,P,2)
+7 KILL ^AMHTMP($JOB)
+8 SET RETVAL="^AMHTMP("_$JOB_")"
+9 SET AMHI=0
+10 SET ^AMHTMP($JOB,AMHI)="T00250Data"_$CHAR(30)
+11 DO INIT^AMHGRAP(AMHP,AMHB,AMHE)
+12 KILL ^TMP("AMHDPA",$JOB,"IDX")
+13 NEW AMHDA,AMHDATA
+14 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^TMP("AMHDPA",$JOB,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+15 SET AMHDATA=$GET(^TMP("AMHDPA",$JOB,AMHDA,0))
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=$GET(AMHDATA)_$CHAR(30)
End DoDot:1
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 KILL ^TMP("AMHDPA",$JOB)
+20 DO EXIT^AMHGRAP
+21 QUIT
+22 ;
PCCL(RETVAL,AMHSTR) ;-- get pcc labs
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,AMHP,AMHB,AMHE
+3 SET P="|"
+4 SET AMHP=$PIECE(AMHSTR,P,3)
+5 SET AMHB=$PIECE(AMHSTR,P)
+6 SET AMHE=$PIECE(AMHSTR,P,2)
+7 SET AMHDM=$PIECE(AMHSTR,P,4)
+8 KILL ^AMHTMP($JOB)
+9 SET RETVAL="^AMHTMP("_$JOB_")"
+10 SET AMHI=0
+11 IF AMHDM="G"
SET ^AMHTMP($JOB,AMHI)="T00010Lab Test IEN^T00040Lab Test^T00010Count^T00030Earliest Test^T00030Latest Test"_$CHAR(30)
+12 IF AMHDM="V"!(AMHDM="DV")
SET ^AMHTMP($JOB,AMHI)="T00250Data"_$CHAR(30)
+13 DO PCCL^AMHGRU(AMHP,AMHB,AMHE,AMHDM)
+14 NEW AMHDA,AMHDATA,AMHIEN,AMHVST,AMHRES,AMHABN,AMHRL,AMHRH,AMHOP,AMHTSI,AMHCNT,AMHEARLY,AMHLAST,AMHCDT
+15 IF AMHDM="G"
Begin DoDot:1
+16 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^TMP("AMHLABG",$JOB,AMHDA))
IF AMHDA=""
QUIT
Begin DoDot:2
+17 SET AMHDATA=$GET(^TMP("AMHLABG",$JOB,AMHDA))
+18 SET AMHTSI=$PIECE(AMHDATA,U)
+19 SET AMHCNT=$PIECE(AMHDATA,U,2)
+20 SET AMHEARLY=$PIECE(AMHDATA,U,3)
+21 SET AMHLAST=$PIECE(AMHDATA,U,4)
+22 SET AMHEARLY=$$LVDT^AMHGU(AMHEARLY)
+23 SET AMHLAST=$$LVDT^AMHGU(AMHLAST)
+24 SET AMHI=AMHI+1
+25 SET @RETVAL@(AMHI)=AMHTSI_U_AMHDA_U_$GET(AMHCNT)_U_AMHEARLY_U_AMHLAST_$CHAR(30)
End DoDot:2
End DoDot:1
+26 IF AMHDM="V"
Begin DoDot:1
+27 SET AMHI=AMHI+1
+28 SET LINE="Collection Date"_$$SP^AMHGRU(9)_"Lab Test"_$$SP^AMHGRU(17)_"Result"_$$SP^AMHGRU(18)_"Abnormal"
+29 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+30 SET AMHI=AMHI+1
+31 SET LINE="Reference Low"_$$SP^AMHGRU(11)_"Reference High"_$$SP^AMHGRU(11)_"Ordering Provider"
+32 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+33 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^TMP("AMHLABV",$JOB,AMHDA))
IF AMHDA=""
QUIT
Begin DoDot:2
+34 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^TMP("AMHLABV",$JOB,AMHDA,AMHIEN))
IF AMHIEN=""
QUIT
Begin DoDot:3
+35 SET AMHDATA=$GET(^TMP("AMHLABV",$JOB,AMHDA,AMHIEN))
+36 SET AMHVST=$PIECE(AMHDATA,U)
+37 SET AMHRES=$PIECE(AMHDATA,U,2)
+38 SET AMHABN=$PIECE(AMHDATA,U,3)
+39 SET AMHRL=$PIECE(AMHDATA,U,4)
+40 SET AMHRH=$PIECE(AMHDATA,U,5)
+41 SET AMHOP=$PIECE(AMHDATA,U,6)
+42 SET AMHCDT=$PIECE(AMHDATA,U,7)
+43 SET AMHI=AMHI+1
+44 ;v4.0p1 pr781
SET LINE=$$PAD^AMHGRU(AMHCDT,24)_$$PAD^AMHGRU(AMHIEN,25)_$$PAD^AMHGRU(AMHRES,24)_AMHABN
+45 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+46 SET LINE=$$PAD^AMHGRU(AMHRL,24)_$$PAD^AMHGRU(AMHRH,25)_AMHOP
+47 SET AMHI=AMHI+1
+48 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+49 SET AMHI=AMHI+1
+50 SET @RETVAL@(AMHI)=""_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+51 IF AMHDM="DV"
Begin DoDot:1
+52 SET AMHI=AMHI+1
+53 SET LINE="Lab Test"_$$SP^AMHGRU(16)_"Collection Date"_$$SP^AMHGRU(10)_"Result"_$$SP^AMHGRU(18)_"Abnormal"
+54 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+55 SET AMHI=AMHI+1
+56 SET LINE="Reference Low"_$$SP^AMHGRU(11)_"Reference High"_$$SP^AMHGRU(11)_"Ordering Provider"
+57 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+58 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^TMP("AMHLABV",$JOB,AMHDA))
IF AMHDA=""
QUIT
Begin DoDot:2
+59 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^TMP("AMHLABV",$JOB,AMHDA,AMHIEN))
IF AMHIEN=""
QUIT
Begin DoDot:3
+60 SET AMHDATA=$GET(^TMP("AMHLABV",$JOB,AMHDA,AMHIEN))
+61 SET AMHVST=$PIECE(AMHDATA,U)
+62 SET AMHRES=$PIECE(AMHDATA,U,2)
+63 SET AMHABN=$PIECE(AMHDATA,U,3)
+64 SET AMHRL=$PIECE(AMHDATA,U,4)
+65 SET AMHRH=$PIECE(AMHDATA,U,5)
+66 SET AMHOP=$PIECE(AMHDATA,U,6)
+67 SET AMHCDT=$PIECE(AMHDATA,U,7)
+68 SET AMHI=AMHI+1
+69 ;v4.0p1 pr781
SET LINE=$$PAD^AMHGRU(AMHDA,24)_$$PAD^AMHGRU(AMHCDT,25)_$$PAD^AMHGRU(AMHRES,24)_AMHABN
+70 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+71 SET LINE=$$PAD^AMHGRU(AMHRL,24)_$$PAD^AMHGRU(AMHRH,25)_AMHOP
+72 SET AMHI=AMHI+1
+73 SET @RETVAL@(AMHI)=LINE_$CHAR(30)
+74 SET AMHI=AMHI+1
+75 SET @RETVAL@(AMHI)=""_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+76 SET @RETVAL@(AMHI+1)=$CHAR(31)
+77 KILL ^TMP("AMHLABG",$JOB)
+78 KILL ^TMP("AMHLABV",$JOB)
+79 QUIT
+80 ;
