AMHGDVF2 ; IHS/CMI/MAW - AMHG BH GUI Visit Form Continued (frmVisitDataEntry) 8/18/2009 2:18:49 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,2,6**;JUN 02, 2010;Build 10
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
EDU(RETVAL,AMHSTR) ;-- retrieve visit education topics
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030EducationTopic^T00010TimeSpent^T00030LevelOfUnderstanding^T00030CPT^T00030Goal^T00030Status^T00010Session^T00100Comment^T00050Readiness^T00010Provider IEN^T00030Provider"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHREDU("AD",AMHIEN,AMHDA)) Q:'AMHDA D
. N AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHSES,AMHLOUI,AMHLOUS,AMHSTI,AMHSTS,AMHCPT,AMHREA,AMHEPRVI,AMHEPRV
. S AMHEDU=$$GET1^DIQ(9002011.05,AMHDA,.01)
. S AMHTS=$$GET1^DIQ(9002011.05,AMHDA,.06)
. S AMHLOUI=$$GET1^DIQ(9002011.05,AMHDA,.08,"I")
. S AMHLOU=$$GET1^DIQ(9002011.05,AMHDA,.08)
. S AMHLOUS=$S($G(AMHLOUI)]"":AMHLOUI_"-"_AMHLOU,1:"")
. S AMHCPT=$$GET1^DIQ(9002011.05,AMHDA,.07)
. S AMHCMT=$$GET1^DIQ(9002011.05,AMHDA,1101)
. S AMHGOAL=$$GET1^DIQ(9002011.05,AMHDA,.09)
. S AMHSTI=$$GET1^DIQ(9002011.05,AMHDA,.11,"I")
. S AMHST=$$GET1^DIQ(9002011.05,AMHDA,.11)
. S AMHSTS=$S($G(AMHSTI)]"":AMHSTI_"-"_AMHST,1:"")
. S AMHSES=$$GET1^DIQ(9002011.05,AMHDA,.05,"I")
. S AMHREA=$$GET1^DIQ(9002011.05,AMHDA,1102)
. S AMHEPRVI=$$GET1^DIQ(9002011.05,AMHDA,.04,"I")
. S AMHEPRV=$$GET1^DIQ(9002011.05,AMHDA,.04)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHDA_U_AMHEDU_U_AMHTS_U_AMHLOU_U_AMHCPT_U_AMHGOAL_U_AMHST_U_AMHSES_U_AMHCMT_U_AMHREA_U_AMHEPRVI_U_AMHEPRV_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
HF(RETVAL,AMHSTR) ;-- retrieve visit health factors
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030HealthFactor^T00030LevelSeverity^T00010Quantity^T00030Provider^T00100Comment"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHRHF("AD",AMHIEN,AMHDA)) Q:'AMHDA D
. N AMHHF,AMHSEV,AMHQTY,AMHPRV,AMHCMT
. S AMHHF=$$GET1^DIQ(9002011.08,AMHDA,.01)
. S AMHSEVI=$$GET1^DIQ(9002011.08,AMHDA,.04,"I")
. S AMHSEV=$$GET1^DIQ(9002011.08,AMHDA,.04)
. S AMHSEVS=$S($G(AMHSEVI)]"":AMHSEVI_"-"_AMHSEV,1:"")
. S AMHQTY=$$GET1^DIQ(9002011.08,AMHDA,.06)
. S AMHPRV=$$GET1^DIQ(9002011.08,AMHDA,.05)
. S AMHCMT=$$GET1^DIQ(9002011.08,AMHDA,81101)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHDA_U_AMHHF_U_AMHSEV_U_AMHQTY_U_AMHPRV_U_AMHCMT_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SCREEN(RETVAL,AMHSTR) ;-- retrieve visit screening
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030AlcoholScreening^T00250AlcoholComment^T00030DepressionScreening^T00250DepressionComment^T00030IPVScreening^T00250IPVComment^T00010Alcohol Provider IEN^T00030Alcohol Provider"
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00010Depression Provider IEN^T00030Depression Provider^T00010IPV Provider IEN^T00030IPV Provider^T00030SRAScreening^T00250SRAComment^T00010SRA Provider IEN^T00030SRA Provider"_$C(30)
N AMHA,AMHAC,AMHD,AMHDC,AMHIP,AMHIPC,AMHAPRVI,AMHAPRV,AMHDPRVI,AMHDPRV,AMHIPRVI,AMHIPRV
N AMHSRA,AMHSRAC,AMHSPRVI,AMHSPRV
S AMHA=$$GET1^DIQ(9002011,AMHIEN,1403)
S AMHAC=$$GET1^DIQ(9002011,AMHIEN,1601)
S AMHD=$$GET1^DIQ(9002011,AMHIEN,1405)
S AMHDC=$$GET1^DIQ(9002011,AMHIEN,1701)
S AMHIP=$$GET1^DIQ(9002011,AMHIEN,1401)
S AMHIPC=$$GET1^DIQ(9002011,AMHIEN,1501)
S AMHAPRVI=$$GET1^DIQ(9002011,AMHIEN,1404,"I")
S AMHAPRV=$$GET1^DIQ(9002011,AMHIEN,1404)
S AMHDPRVI=$$GET1^DIQ(9002011,AMHIEN,1406,"I")
S AMHDPRV=$$GET1^DIQ(9002011,AMHIEN,1406)
S AMHIPRVI=$$GET1^DIQ(9002011,AMHIEN,1402,"I")
S AMHIPRV=$$GET1^DIQ(9002011,AMHIEN,1402)
S AMHSRA=$$GET1^DIQ(9002011,AMHIEN,1407)
S AMHSRAC=$$GET1^DIQ(9002011,AMHIEN,1901)
S AMHSPRVI=$$GET1^DIQ(9002011,AMHIEN,1408,"I")
S AMHSPRV=$$GET1^DIQ(9002011,AMHIEN,1408)
S AMHI=AMHI+1
I AMHA="",AMHAC="",AMHD="",AMHDC="",AMHIP="",AMHIPC="" D Q
. S @RETVAL@(AMHI)=$C(31)
S @RETVAL@(AMHI)=AMHIEN_U_AMHA_U_AMHAC_U_AMHD_U_AMHDC_U_AMHIP_U_AMHIPC_U_AMHAPRVI_U_AMHAPRV_U_AMHDPRVI_U_AMHDPRV_U_AMHIPRVI_U_AMHIPRV
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_U_AMHSRA_U_AMHSRAC_U_AMHSPRVI_U_AMHSPRV_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
TIG(RETVAL,AMHSTR) ;-- retrieve visit time in group
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00010TimeInGroup"_$C(30)
N AMHTIG
S AMHTIG=$$GET1^DIQ(9002011,AMHIEN,1104)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHIEN_U_AMHTIG_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
FLAG(RETVAL,AMHSTR) ;-- retrieve visit flag
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00010Flag"_$C(30)
N AMHFLG
S AMHFLG=$$GET1^DIQ(9002011,AMHIEN,.27)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHIEN_U_AMHFLG_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
MSRT(RETVAL,AMHSTR) ;-- get the patients measurements so they can be graphed
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHB,AMHE,AMHP
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHB=$P(AMHSTR,P,2)
S AMHE=$P(AMHSTR,P,3)
S AMHP=$P(AMHSTR,P)
S AMHB=9999999-AMHB
S AMHE=9999999-AMHE
S @RETVAL@(AMHI)="T00010Type^T00050Description^T00030Count"_$C(30)
N AMHT
S AMHT=0 F S AMHT=$O(^AMHRMSR("AA",AMHP,AMHT)) Q:'AMHT D
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="PR"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="AUD"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="SN"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="ED"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="HE"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="VC"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="VU"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="CXD"
. Q:$$GET1^DIQ(9999999.07,AMHT,.01)="EF"
. N AMHDA
. S AMHDA=(AMHE-.0001) F S AMHDA=$O(^AMHRMSR("AA",AMHP,AMHT,AMHDA)) Q:'AMHDA!(AMHDA>(AMHB+.9999)) D
.. N AMHIEN
.. S AMHIEN=0 F S AMHIEN=$O(^AMHRMSR("AA",AMHP,AMHT,AMHDA,AMHIEN)) Q:'AMHIEN D
... N AMHMSRTI,AMHMSRT,AMHMSRD,AMHV,AMHMDT,AMHMSR
... S:'$D(^AMHGTMP($J,AMHP,AMHT)) ^AMHGTMP($J,AMHP,AMHT)=0
... S ^AMHGTMP($J,AMHP,AMHT)=^AMHGTMP($J,AMHP,AMHT)+1
N AMHTDA
S AMHTDA=0 F S AMHTDA=$O(^AMHGTMP($J,AMHP,AMHTDA)) Q:AMHTDA="" D
. N CNT,TYPE,DESC
. S CNT=$G(^AMHGTMP($J,AMHP,AMHTDA))
. S AMHI=AMHI+1
. S TYPE=$$GET1^DIQ(9999999.07,AMHTDA,.01)
. S DESC=$$GET1^DIQ(9999999.07,AMHTDA,.02)
. S @RETVAL@(AMHI)=TYPE_U_DESC_U_CNT_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
K ^AMHGTMP($J,AMHP)
Q
;
MSRC(RETVAL,AMHSTR) ;-- get the chartable measurement
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHMST,AMHBD,AMHED
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHMST=$P(AMHSTR,P,2)
S AMHBD=$P(AMHSTR,P,3)
S AMHED=$P(AMHSTR,P,4)
S INST=999999 ;for testing
;S @RETVAL@($J,AMHI)="T00020Begin Date^T00020End Date^T00020Date^T00004Systolic^T00004Diastolic^T00007Chart"_$C(30)
N AMHDA
S AMHCNT=0
S AMHBDA=9999999-AMHBD
S AMHEDA=9999999-AMHED
S AMHMSTI=$O(^AUTTMSR("B",AMHMST,0))
D SETHDR(RETVAL,AMHMSTI)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHRMSR("AA",AMHIEN,AMHMSTI,AMHDA)) Q:'AMHDA!(AMHDA>AMHBDA)!(AMHCNT>INST) D
. ;Q:AMHCNT>INST
. N AMHOEN
. S AMHOEN=0 F S AMHOEN=$O(^AMHRMSR("AA",AMHIEN,AMHMSTI,AMHDA,AMHOEN)) Q:'AMHOEN D
.. N AMHVAL,AMHVDT,AMHVAL1,AMHVAL2
.. Q:AMHCNT>INST
.. S AMHCNT=AMHCNT+1
.. S AMHVAL=$P($G(^AMHRMSR(AMHOEN,0)),U,4)
.. S AMHVAL1=$P(AMHVAL,"/")
.. S AMHVAL2=$P(AMHVAL,"/",2)
.. S AMHVDT=9999999-AMHDA
.. ;S AMHI=AMHI+1
.. ;S @RETVAL@(AMHI)=$$LVDT^AMHGU(AMHVDT)_U_AMHVAL1_U_AMHVAL2_$C(30)
.. S ^TMP($J,"AMHGUI",AMHVDT,AMHIEN)=$$LVDT^AMHGU(AMHVDT)_U_AMHVAL1_$S(AMHVAL2]"":U_AMHVAL2,1:"")
N AMHTDA,AMHTIEM
S AMHTDA=0 F S AMHTDA=$O(^TMP($J,"AMHGUI",AMHTDA)) Q:'AMHTDA D
. S AMHTIEN=0 F S AMHTIEN=$O(^TMP($J,"AMHGUI",AMHTDA,AMHTIEN)) Q:'AMHTIEN D
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=$G(^TMP($J,"AMHGUI",AMHTDA,AMHTIEN))_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
K ^TMP($J,"AMHGUI")
Q
;
SETHDR(RV,MSTI) ;-- set the header based on measurement type
N MSRD,MSRT
S MSRT=$P($G(^AUTTMSR(MSTI,0)),U)
S MSRD=$P($G(^AUTTMSR(MSTI,0)),U,2)
S @RV@(0)="T00030Date^T00030"_MSRD_$C(30)
I MSRT="BP" D
. S @RV@(0)="T00030Date^T00030Systolic^T00030Diastolic"_$C(30)
Q
;
TIU(RETVAL,AMHSTR) ;EP -- return the TIU notes into a data table for the visit
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIN=$P(AMHSTR,P)
S @RETVAL@(0)="T00250Soap"_$C(30)
D TIUN(.AMHARRAY,AMHIN)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^TMP("AMHS",$J,"DCS",AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^TMP("AMHS",$J,"DCS",AMHDA))
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
K ^TMP("AMHOENPS",$J)
K ^TMP("AMHS",$J)
Q
;
TIUN(AMHARRAY,AMHIEN) ;EP called to return TIU notes in an array
N AMHR,AMHTIU,AMHDOC,AMHERR,AMHSTR,AMHGBL,AMHX1,AMHX
I '$O(^AMHREC(AMHIEN,54,0)) Q
S AMHARRAY="^TMP(""AMHS"","_$J_",""DCS"")"
S AMHR=AMHIEN
K @AMHARRAY S @AMHARRAY@(0)=0
S X="" D S(X) D S("TIU DOCUMENTS") D S("-------------")
S AMHDOC=0 F S AMHDOC=$O(^AMHREC(AMHIEN,54,"B",AMHDOC)) Q:AMHDOC'=+AMHDOC D
.K AMHTIU,AMHERR
.K ^TMP("AMHOENPS",$J)
.D TIUDSP
.D S(" ") ;cmi/maw pr582
.K ^TMP("AMHEONPS",$J)
.K AMHTIU
.Q
Q
;
TIUDSP ;
S AMHSTR="" D S(AMHSTR)
I '+$$CANDO^TIULP(AMHDOC,"PRINT RECORD",DUZ) Q ;S AMHSTR="You do not have security clearance to display the TIU NOTE." D S(AMHSTR) Q
; Extract specified note
S AMHGBL=$NA(^TMP("AMHOENPS",$J)),AMHHLF=IOM\2
K @AMHGBL
D EXTRACT^TIULQ(AMHDOC,AMHGBL,.AMHERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
M AMHTIU=^TMP("AMHOENPS",$J,AMHDOC)
K ^TMP("AMHOENPS",$J)
S AMHSTR="TIU DOCUMENT: "_AMHTIU(.01,"E") D S(AMHSTR)
S AMHSTR="AUTHOR: "_AMHTIU(1202,"E") D S(AMHSTR)
S AMHSTR="SIGNED BY: "_AMHTIU(1502,"E")_" STATUS: "_AMHTIU(.05,"E") D S(AMHSTR)
S AMHSTR="LOCATION: "_AMHTIU(1205,"E") D S(AMHSTR)
F AMHX=0:0 S AMHX=$O(AMHTIU("TEXT",AMHX)) Q:'AMHX S AMHSTR=AMHTIU("TEXT",AMHX,0) D S(AMHSTR)
I $L($G(AMHTIU(1501,"E"))) D
.S AMHSTR="/es/ "_$G(AMHTIU(1503,"E")) D S(AMHSTR)
.S AMHSTR="Signed: "_$G(AMHTIU(1501,"E")) D S(AMHSTR)
;NOW GET ADDENDA USING "DAD" XREF
I $O(^TIU(8925,"DAD",AMHDOC,0)) S AMHSTR="" D S(AMHSTR) ;S AMHSTR="This document has addenda." D S(AMHSTR)
S AMHX1=0 F S AMHX1=$O(^TIU(8925,"DAD",AMHDOC,AMHX1)) Q:AMHX1'=+AMHX1 D
.I '+$$CANDO^TIULP(AMHX1,"PRINT RECORD",DUZ) Q ;S AMHSTR="You do not have security clearance to display the addendum." D S(AMHSTR) Q
.S AMHGBL=$NA(^TMP("AMHOENPS",$J))
.K @AMHGBL
.K AMHTIU
.D EXTRACT^TIULQ(AMHX1,AMHGBL,.AMHERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
.M AMHTIU=^TMP("AMHOENPS",$J,AMHX1)
.K ^TMP("AMHOENPS",$J)
.S AMHSTR=" " D S(AMHSTR)
.S AMHSTR=AMHTIU(.01,"E") D S(AMHSTR)
.S AMHSTR="AUTHOR: "_AMHTIU(1202,"E") D S(AMHSTR)
.S AMHSTR="SIGNED BY: "_AMHTIU(1502,"E")_" STATUS: "_AMHTIU(.05,"E") D S(AMHSTR)
.S AMHSTR="LOCATION: "_AMHTIU(1205,"E") D S(AMHSTR)
.F AMHX=0:0 S AMHX=$O(AMHTIU("TEXT",AMHX)) Q:'AMHX S AMHSTR=AMHTIU("TEXT",AMHX,0) D S(AMHSTR)
.I $L($G(AMHTIU(1501,"E"))) D
..S AMHSTR="/es/ "_$G(AMHTIU(1503,"E")) D S(AMHSTR)
..S AMHSTR="Signed: "_$G(AMHTIU(1501,"E")) D S(AMHSTR)
;
Q
S(Y,F,C,T) ;set up array
NEW %
I '$G(F) S F=0
I '$G(T) S T=0
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("AMHS",$J,"DCS",0),U)+1,$P(^TMP("AMHS",$J,"DCS",0),U)=%
S ^TMP("AMHS",$J,"DCS",%)=X
Q
;
AMHGDVF2 ; IHS/CMI/MAW - AMHG BH GUI Visit Form Continued (frmVisitDataEntry) 8/18/2009 2:18:49 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,6**;JUN 02, 2010;Build 10
+2 ;
+3 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
EDU(RETVAL,AMHSTR) ;-- retrieve visit education topics
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030EducationTopic^T00010TimeSpent^T00030LevelOfUnderstanding^T00030CPT^T00030Goal^T00030Status^T00010Session^T00100Comment^T00050Readiness^T00010Provider IEN^T00030Provider"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHREDU("AD",AMHIEN,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHSES,AMHLOUI,AMHLOUS,AMHSTI,AMHSTS,AMHCPT,AMHREA,AMHEPRVI,AMHEPRV
+12 SET AMHEDU=$$GET1^DIQ(9002011.05,AMHDA,.01)
+13 SET AMHTS=$$GET1^DIQ(9002011.05,AMHDA,.06)
+14 SET AMHLOUI=$$GET1^DIQ(9002011.05,AMHDA,.08,"I")
+15 SET AMHLOU=$$GET1^DIQ(9002011.05,AMHDA,.08)
+16 SET AMHLOUS=$SELECT($GET(AMHLOUI)]"":AMHLOUI_"-"_AMHLOU,1:"")
+17 SET AMHCPT=$$GET1^DIQ(9002011.05,AMHDA,.07)
+18 SET AMHCMT=$$GET1^DIQ(9002011.05,AMHDA,1101)
+19 SET AMHGOAL=$$GET1^DIQ(9002011.05,AMHDA,.09)
+20 SET AMHSTI=$$GET1^DIQ(9002011.05,AMHDA,.11,"I")
+21 SET AMHST=$$GET1^DIQ(9002011.05,AMHDA,.11)
+22 SET AMHSTS=$SELECT($GET(AMHSTI)]"":AMHSTI_"-"_AMHST,1:"")
+23 SET AMHSES=$$GET1^DIQ(9002011.05,AMHDA,.05,"I")
+24 SET AMHREA=$$GET1^DIQ(9002011.05,AMHDA,1102)
+25 SET AMHEPRVI=$$GET1^DIQ(9002011.05,AMHDA,.04,"I")
+26 SET AMHEPRV=$$GET1^DIQ(9002011.05,AMHDA,.04)
+27 SET AMHI=AMHI+1
+28 SET @RETVAL@(AMHI)=AMHDA_U_AMHEDU_U_AMHTS_U_AMHLOU_U_AMHCPT_U_AMHGOAL_U_AMHST_U_AMHSES_U_AMHCMT_U_AMHREA_U_AMHEPRVI_U_AMHEPRV_$CHAR(30)
End DoDot:1
+29 SET @RETVAL@(AMHI+1)=$CHAR(31)
+30 QUIT
+31 ;
HF(RETVAL,AMHSTR) ;-- retrieve visit health factors
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030HealthFactor^T00030LevelSeverity^T00010Quantity^T00030Provider^T00100Comment"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHRHF("AD",AMHIEN,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHHF,AMHSEV,AMHQTY,AMHPRV,AMHCMT
+12 SET AMHHF=$$GET1^DIQ(9002011.08,AMHDA,.01)
+13 SET AMHSEVI=$$GET1^DIQ(9002011.08,AMHDA,.04,"I")
+14 SET AMHSEV=$$GET1^DIQ(9002011.08,AMHDA,.04)
+15 SET AMHSEVS=$SELECT($GET(AMHSEVI)]"":AMHSEVI_"-"_AMHSEV,1:"")
+16 SET AMHQTY=$$GET1^DIQ(9002011.08,AMHDA,.06)
+17 SET AMHPRV=$$GET1^DIQ(9002011.08,AMHDA,.05)
+18 SET AMHCMT=$$GET1^DIQ(9002011.08,AMHDA,81101)
+19 SET AMHI=AMHI+1
+20 SET @RETVAL@(AMHI)=AMHDA_U_AMHHF_U_AMHSEV_U_AMHQTY_U_AMHPRV_U_AMHCMT_$CHAR(30)
End DoDot:1
+21 SET @RETVAL@(AMHI+1)=$CHAR(31)
+22 QUIT
+23 ;
SCREEN(RETVAL,AMHSTR) ;-- retrieve visit screening
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030AlcoholScreening^T00250AlcoholComment^T00030DepressionScreening^T00250DepressionComment^T00030IPVScreening^T00250IPVComment^T00010Alcohol Provider IEN^T00030Alcohol Provider"
+9 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00010Depression Provider IEN^T00030Depression Provider^T00010IPV Provider IEN^T00030IPV Provider^T00030SRAScreening^T00250SRAComment^T00010SRA Provider IEN^T00030SRA Provider"_$CHAR(30)
+10 NEW AMHA,AMHAC,AMHD,AMHDC,AMHIP,AMHIPC,AMHAPRVI,AMHAPRV,AMHDPRVI,AMHDPRV,AMHIPRVI,AMHIPRV
+11 NEW AMHSRA,AMHSRAC,AMHSPRVI,AMHSPRV
+12 SET AMHA=$$GET1^DIQ(9002011,AMHIEN,1403)
+13 SET AMHAC=$$GET1^DIQ(9002011,AMHIEN,1601)
+14 SET AMHD=$$GET1^DIQ(9002011,AMHIEN,1405)
+15 SET AMHDC=$$GET1^DIQ(9002011,AMHIEN,1701)
+16 SET AMHIP=$$GET1^DIQ(9002011,AMHIEN,1401)
+17 SET AMHIPC=$$GET1^DIQ(9002011,AMHIEN,1501)
+18 SET AMHAPRVI=$$GET1^DIQ(9002011,AMHIEN,1404,"I")
+19 SET AMHAPRV=$$GET1^DIQ(9002011,AMHIEN,1404)
+20 SET AMHDPRVI=$$GET1^DIQ(9002011,AMHIEN,1406,"I")
+21 SET AMHDPRV=$$GET1^DIQ(9002011,AMHIEN,1406)
+22 SET AMHIPRVI=$$GET1^DIQ(9002011,AMHIEN,1402,"I")
+23 SET AMHIPRV=$$GET1^DIQ(9002011,AMHIEN,1402)
+24 SET AMHSRA=$$GET1^DIQ(9002011,AMHIEN,1407)
+25 SET AMHSRAC=$$GET1^DIQ(9002011,AMHIEN,1901)
+26 SET AMHSPRVI=$$GET1^DIQ(9002011,AMHIEN,1408,"I")
+27 SET AMHSPRV=$$GET1^DIQ(9002011,AMHIEN,1408)
+28 SET AMHI=AMHI+1
+29 IF AMHA=""
IF AMHAC=""
IF AMHD=""
IF AMHDC=""
IF AMHIP=""
IF AMHIPC=""
Begin DoDot:1
+30 SET @RETVAL@(AMHI)=$CHAR(31)
End DoDot:1
QUIT
+31 SET @RETVAL@(AMHI)=AMHIEN_U_AMHA_U_AMHAC_U_AMHD_U_AMHDC_U_AMHIP_U_AMHIPC_U_AMHAPRVI_U_AMHAPRV_U_AMHDPRVI_U_AMHDPRV_U_AMHIPRVI_U_AMHIPRV
+32 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_U_AMHSRA_U_AMHSRAC_U_AMHSPRVI_U_AMHSPRV_$CHAR(30)
+33 SET @RETVAL@(AMHI+1)=$CHAR(31)
+34 QUIT
+35 ;
TIG(RETVAL,AMHSTR) ;-- retrieve visit time in group
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00010TimeInGroup"_$CHAR(30)
+9 NEW AMHTIG
+10 SET AMHTIG=$$GET1^DIQ(9002011,AMHIEN,1104)
+11 SET AMHI=AMHI+1
+12 SET @RETVAL@(AMHI)=AMHIEN_U_AMHTIG_$CHAR(30)
+13 SET @RETVAL@(AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
FLAG(RETVAL,AMHSTR) ;-- retrieve visit flag
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00010Flag"_$CHAR(30)
+9 NEW AMHFLG
+10 SET AMHFLG=$$GET1^DIQ(9002011,AMHIEN,.27)
+11 SET AMHI=AMHI+1
+12 SET @RETVAL@(AMHI)=AMHIEN_U_AMHFLG_$CHAR(30)
+13 SET @RETVAL@(AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
MSRT(RETVAL,AMHSTR) ;-- get the patients measurements so they can be graphed
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHB,AMHE,AMHP
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHB=$PIECE(AMHSTR,P,2)
+8 SET AMHE=$PIECE(AMHSTR,P,3)
+9 SET AMHP=$PIECE(AMHSTR,P)
+10 SET AMHB=9999999-AMHB
+11 SET AMHE=9999999-AMHE
+12 SET @RETVAL@(AMHI)="T00010Type^T00050Description^T00030Count"_$CHAR(30)
+13 NEW AMHT
+14 SET AMHT=0
FOR
SET AMHT=$ORDER(^AMHRMSR("AA",AMHP,AMHT))
IF 'AMHT
QUIT
Begin DoDot:1
+15 IF $$GET1^DIQ(9999999.07,AMHT,.01)="PR"
QUIT
+16 IF $$GET1^DIQ(9999999.07,AMHT,.01)="AUD"
QUIT
+17 IF $$GET1^DIQ(9999999.07,AMHT,.01)="SN"
QUIT
+18 IF $$GET1^DIQ(9999999.07,AMHT,.01)="ED"
QUIT
+19 IF $$GET1^DIQ(9999999.07,AMHT,.01)="HE"
QUIT
+20 IF $$GET1^DIQ(9999999.07,AMHT,.01)="VC"
QUIT
+21 IF $$GET1^DIQ(9999999.07,AMHT,.01)="VU"
QUIT
+22 IF $$GET1^DIQ(9999999.07,AMHT,.01)="CXD"
QUIT
+23 IF $$GET1^DIQ(9999999.07,AMHT,.01)="EF"
QUIT
+24 NEW AMHDA
+25 SET AMHDA=(AMHE-.0001)
FOR
SET AMHDA=$ORDER(^AMHRMSR("AA",AMHP,AMHT,AMHDA))
IF 'AMHDA!(AMHDA>(AMHB+.9999))
QUIT
Begin DoDot:2
+26 NEW AMHIEN
+27 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHRMSR("AA",AMHP,AMHT,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:3
+28 NEW AMHMSRTI,AMHMSRT,AMHMSRD,AMHV,AMHMDT,AMHMSR
+29 IF '$DATA(^AMHGTMP($JOB,AMHP,AMHT))
SET ^AMHGTMP($JOB,AMHP,AMHT)=0
+30 SET ^AMHGTMP($JOB,AMHP,AMHT)=^AMHGTMP($JOB,AMHP,AMHT)+1
End DoDot:3
End DoDot:2
End DoDot:1
+31 NEW AMHTDA
+32 SET AMHTDA=0
FOR
SET AMHTDA=$ORDER(^AMHGTMP($JOB,AMHP,AMHTDA))
IF AMHTDA=""
QUIT
Begin DoDot:1
+33 NEW CNT,TYPE,DESC
+34 SET CNT=$GET(^AMHGTMP($JOB,AMHP,AMHTDA))
+35 SET AMHI=AMHI+1
+36 SET TYPE=$$GET1^DIQ(9999999.07,AMHTDA,.01)
+37 SET DESC=$$GET1^DIQ(9999999.07,AMHTDA,.02)
+38 SET @RETVAL@(AMHI)=TYPE_U_DESC_U_CNT_$CHAR(30)
End DoDot:1
+39 SET @RETVAL@(AMHI+1)=$CHAR(31)
+40 KILL ^AMHGTMP($JOB,AMHP)
+41 QUIT
+42 ;
MSRC(RETVAL,AMHSTR) ;-- get the chartable measurement
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHMST,AMHBD,AMHED
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET AMHMST=$PIECE(AMHSTR,P,2)
+9 SET AMHBD=$PIECE(AMHSTR,P,3)
+10 SET AMHED=$PIECE(AMHSTR,P,4)
+11 ;for testing
SET INST=999999
+12 ;S @RETVAL@($J,AMHI)="T00020Begin Date^T00020End Date^T00020Date^T00004Systolic^T00004Diastolic^T00007Chart"_$C(30)
+13 NEW AMHDA
+14 SET AMHCNT=0
+15 SET AMHBDA=9999999-AMHBD
+16 SET AMHEDA=9999999-AMHED
+17 SET AMHMSTI=$ORDER(^AUTTMSR("B",AMHMST,0))
+18 DO SETHDR(RETVAL,AMHMSTI)
+19 NEW AMHDA
+20 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHRMSR("AA",AMHIEN,AMHMSTI,AMHDA))
IF 'AMHDA!(AMHDA>AMHBDA)!(AMHCNT>INST)
QUIT
Begin DoDot:1
+21 ;Q:AMHCNT>INST
+22 NEW AMHOEN
+23 SET AMHOEN=0
FOR
SET AMHOEN=$ORDER(^AMHRMSR("AA",AMHIEN,AMHMSTI,AMHDA,AMHOEN))
IF 'AMHOEN
QUIT
Begin DoDot:2
+24 NEW AMHVAL,AMHVDT,AMHVAL1,AMHVAL2
+25 IF AMHCNT>INST
QUIT
+26 SET AMHCNT=AMHCNT+1
+27 SET AMHVAL=$PIECE($GET(^AMHRMSR(AMHOEN,0)),U,4)
+28 SET AMHVAL1=$PIECE(AMHVAL,"/")
+29 SET AMHVAL2=$PIECE(AMHVAL,"/",2)
+30 SET AMHVDT=9999999-AMHDA
+31 ;S AMHI=AMHI+1
+32 ;S @RETVAL@(AMHI)=$$LVDT^AMHGU(AMHVDT)_U_AMHVAL1_U_AMHVAL2_$C(30)
+33 SET ^TMP($JOB,"AMHGUI",AMHVDT,AMHIEN)=$$LVDT^AMHGU(AMHVDT)_U_AMHVAL1_$SELECT(AMHVAL2]"":U_AMHVAL2,1:"")
End DoDot:2
End DoDot:1
+34 NEW AMHTDA,AMHTIEM
+35 SET AMHTDA=0
FOR
SET AMHTDA=$ORDER(^TMP($JOB,"AMHGUI",AMHTDA))
IF 'AMHTDA
QUIT
Begin DoDot:1
+36 SET AMHTIEN=0
FOR
SET AMHTIEN=$ORDER(^TMP($JOB,"AMHGUI",AMHTDA,AMHTIEN))
IF 'AMHTIEN
QUIT
Begin DoDot:2
+37 SET AMHI=AMHI+1
+38 SET @RETVAL@(AMHI)=$GET(^TMP($JOB,"AMHGUI",AMHTDA,AMHTIEN))_$CHAR(30)
End DoDot:2
End DoDot:1
+39 SET @RETVAL@(AMHI+1)=$CHAR(31)
+40 KILL ^TMP($JOB,"AMHGUI")
+41 QUIT
+42 ;
SETHDR(RV,MSTI) ;-- set the header based on measurement type
+1 NEW MSRD,MSRT
+2 SET MSRT=$PIECE($GET(^AUTTMSR(MSTI,0)),U)
+3 SET MSRD=$PIECE($GET(^AUTTMSR(MSTI,0)),U,2)
+4 SET @RV@(0)="T00030Date^T00030"_MSRD_$CHAR(30)
+5 IF MSRT="BP"
Begin DoDot:1
+6 SET @RV@(0)="T00030Date^T00030Systolic^T00030Diastolic"_$CHAR(30)
End DoDot:1
+7 QUIT
+8 ;
TIU(RETVAL,AMHSTR) ;EP -- return the TIU notes into a data table for the visit
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIN=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(0)="T00250Soap"_$CHAR(30)
+9 DO TIUN(.AMHARRAY,AMHIN)
+10 NEW AMHDA
+11 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^TMP("AMHS",$JOB,"DCS",AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+12 NEW AMHDATA
+13 SET AMHDATA=$GET(^TMP("AMHS",$JOB,"DCS",AMHDA))
+14 SET AMHI=AMHI+1
+15 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 KILL ^TMP("AMHOENPS",$JOB)
+18 KILL ^TMP("AMHS",$JOB)
+19 QUIT
+20 ;
TIUN(AMHARRAY,AMHIEN) ;EP called to return TIU notes in an array
+1 NEW AMHR,AMHTIU,AMHDOC,AMHERR,AMHSTR,AMHGBL,AMHX1,AMHX
+2 IF '$ORDER(^AMHREC(AMHIEN,54,0))
QUIT
+3 SET AMHARRAY="^TMP(""AMHS"","_$JOB_",""DCS"")"
+4 SET AMHR=AMHIEN
+5 KILL @AMHARRAY
SET @AMHARRAY@(0)=0
+6 SET X=""
DO S(X)
DO S("TIU DOCUMENTS")
DO S("-------------")
+7 SET AMHDOC=0
FOR
SET AMHDOC=$ORDER(^AMHREC(AMHIEN,54,"B",AMHDOC))
IF AMHDOC'=+AMHDOC
QUIT
Begin DoDot:1
+8 KILL AMHTIU,AMHERR
+9 KILL ^TMP("AMHOENPS",$JOB)
+10 DO TIUDSP
+11 ;cmi/maw pr582
DO S(" ")
+12 KILL ^TMP("AMHEONPS",$JOB)
+13 KILL AMHTIU
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
TIUDSP ;
+1 SET AMHSTR=""
DO S(AMHSTR)
+2 ;S AMHSTR="You do not have security clearance to display the TIU NOTE." D S(AMHSTR) Q
IF '+$$CANDO^TIULP(AMHDOC,"PRINT RECORD",DUZ)
QUIT
+3 ; Extract specified note
+4 SET AMHGBL=$NAME(^TMP("AMHOENPS",$JOB))
SET AMHHLF=IOM\2
+5 KILL @AMHGBL
+6 DO EXTRACT^TIULQ(AMHDOC,AMHGBL,.AMHERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
+7 MERGE AMHTIU=^TMP("AMHOENPS",$JOB,AMHDOC)
+8 KILL ^TMP("AMHOENPS",$JOB)
+9 SET AMHSTR="TIU DOCUMENT: "_AMHTIU(.01,"E")
DO S(AMHSTR)
+10 SET AMHSTR="AUTHOR: "_AMHTIU(1202,"E")
DO S(AMHSTR)
+11 SET AMHSTR="SIGNED BY: "_AMHTIU(1502,"E")_" STATUS: "_AMHTIU(.05,"E")
DO S(AMHSTR)
+12 SET AMHSTR="LOCATION: "_AMHTIU(1205,"E")
DO S(AMHSTR)
+13 FOR AMHX=0:0
SET AMHX=$ORDER(AMHTIU("TEXT",AMHX))
IF 'AMHX
QUIT
SET AMHSTR=AMHTIU("TEXT",AMHX,0)
DO S(AMHSTR)
+14 IF $LENGTH($GET(AMHTIU(1501,"E")))
Begin DoDot:1
+15 SET AMHSTR="/es/ "_$GET(AMHTIU(1503,"E"))
DO S(AMHSTR)
+16 SET AMHSTR="Signed: "_$GET(AMHTIU(1501,"E"))
DO S(AMHSTR)
End DoDot:1
+17 ;NOW GET ADDENDA USING "DAD" XREF
+18 ;S AMHSTR="This document has addenda." D S(AMHSTR)
IF $ORDER(^TIU(8925,"DAD",AMHDOC,0))
SET AMHSTR=""
DO S(AMHSTR)
+19 SET AMHX1=0
FOR
SET AMHX1=$ORDER(^TIU(8925,"DAD",AMHDOC,AMHX1))
IF AMHX1'=+AMHX1
QUIT
Begin DoDot:1
+20 ;S AMHSTR="You do not have security clearance to display the addendum." D S(AMHSTR) Q
IF '+$$CANDO^TIULP(AMHX1,"PRINT RECORD",DUZ)
QUIT
+21 SET AMHGBL=$NAME(^TMP("AMHOENPS",$JOB))
+22 KILL @AMHGBL
+23 KILL AMHTIU
+24 DO EXTRACT^TIULQ(AMHX1,AMHGBL,.AMHERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
+25 MERGE AMHTIU=^TMP("AMHOENPS",$JOB,AMHX1)
+26 KILL ^TMP("AMHOENPS",$JOB)
+27 SET AMHSTR=" "
DO S(AMHSTR)
+28 SET AMHSTR=AMHTIU(.01,"E")
DO S(AMHSTR)
+29 SET AMHSTR="AUTHOR: "_AMHTIU(1202,"E")
DO S(AMHSTR)
+30 SET AMHSTR="SIGNED BY: "_AMHTIU(1502,"E")_" STATUS: "_AMHTIU(.05,"E")
DO S(AMHSTR)
+31 SET AMHSTR="LOCATION: "_AMHTIU(1205,"E")
DO S(AMHSTR)
+32 FOR AMHX=0:0
SET AMHX=$ORDER(AMHTIU("TEXT",AMHX))
IF 'AMHX
QUIT
SET AMHSTR=AMHTIU("TEXT",AMHX,0)
DO S(AMHSTR)
+33 IF $LENGTH($GET(AMHTIU(1501,"E")))
Begin DoDot:2
+34 SET AMHSTR="/es/ "_$GET(AMHTIU(1503,"E"))
DO S(AMHSTR)
+35 SET AMHSTR="Signed: "_$GET(AMHTIU(1501,"E"))
DO S(AMHSTR)
End DoDot:2
End DoDot:1
+36 ;
+37 QUIT
S(Y,F,C,T) ;set up array
+1 NEW %
+2 IF '$GET(F)
SET F=0
+3 IF '$GET(T)
SET T=0
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("AMHS",$JOB,"DCS",0),U)+1
SET $PIECE(^TMP("AMHS",$JOB,"DCS",0),U)=%
+2 SET ^TMP("AMHS",$JOB,"DCS",%)=X
+3 QUIT
+4 ;
