Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHGDVF2

AMHGDVF2.m

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