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

AMHLEFP3.m

Go to the documentation of this file. 
  1. AMHLEFP3  ; IHS/TUCSON/LAB -VISIT DISPLAY ;     
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1. S(Y,F,C,T) ;set up array
  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. TIUDSP ;EP
  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. BUILD1 ;
  1.  S AMHSTR=$E(AMHH,1,21)_":",AMHSTR=$$SETSTR^VALM1(AMHV,AMHSTR,24,$L(AMHV))
  1.  D S(AMHSTR)
  1.  Q
  1. SAN ;EP
  1.  Q:$G(AMHEFT)'="F"
  1.  S AMHSTR="=============== "_"BH SAN DATA ITEMS"_" ===============",X=(80-$L(AMHSTR)\2) D S(AMHSTR,1) ;$J("",X)_AMHSTR D S(AMHSTR)
  1.  I $P(^AMHREC(AMHR,0),U,33)="U" D SANU Q
  1. 1 ;
  1.  K AMHAR
  1.  D ENP^XBDIQ1(9002011,AMHR,"7701;7702;7703;7704;7706;7707;7901","AMHAR(","E")
  1.  S F=0 F  S F=$O(AMHAR(F)) Q:F'=+F  I AMHAR(F)]"" D
  1.  .S AMHH=$P(^DD(9002011,F,0),U)
  1.  .S AMHV=AMHAR(F)
  1.  .D BUILD1
  1. 2 ;
  1.  K AMHAR
  1.  F AMHX=7709,7717,7711,7712 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1.  .Q
  1. 3 ;
  1.  K AMHAR
  1.  D ENP^XBDIQ1(9002011,AMHR,7713,"AMHAR(","E")
  1.  S F=0 F  S F=$O(AMHAR(F)) Q:F'=+F  I AMHAR(F)]"" D
  1.  .S AMHH=$P(^DD(9002011,F,0),U)
  1.  .S AMHV=AMHAR(F)
  1.  .D BUILD1
  1. 4 ;
  1.  K AMHAR
  1.  F AMHX=7715 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1. 5 ;
  1.  K AMHAR
  1.  D ENP^XBDIQ1(9002011,AMHR,"7902;7719;7721;7722;7903;7904;7905","AMHAR(","E")
  1.  S F=0 F  S F=$O(AMHAR(F)) Q:F'=+F  I AMHAR(F)]"" D
  1.  .S AMHH=$P(^DD(9002011,F,0),U)
  1.  .S AMHV=AMHAR(F)
  1.  .D BUILD1
  1. 6 ;
  1.  K AMHAR
  1.  F AMHX=7724 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1.  .Q
  1.  S AMHSTR="" D S(AMHSTR)
  1.  Q
  1. SANU ;
  1.  K AMHAR
  1.  F AMHX=7801 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1.  .Q
  1. 78 ;
  1.  K AMHAR
  1.  D ENP^XBDIQ1(9002011,AMHR,7802,"AMHAR(","E")
  1.  S F=0 F  S F=$O(AMHAR(F)) Q:F'=+F  I AMHAR(F)]"" D
  1.  .S AMHH=$P(^DD(9002011,F,0),U)
  1.  .S AMHV=AMHAR(F)
  1.  .D BUILD1
  1. 783 ;
  1.  K AMHAR
  1.  F AMHX=7803:1:7805 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1.  .Q
  1. 786 ; 
  1.  K AMHAR
  1.  D ENP^XBDIQ1(9002011,AMHR,7806,"AMHAR(","E")
  1.  S F=0 F  S F=$O(AMHAR(F)) Q:F'=+F  I AMHAR(F)]"" D
  1.  .S AMHH=$P(^DD(9002011,F,0),U)
  1.  .S AMHV=AMHAR(F)
  1.  .D BUILD1
  1. 787 ;
  1.  K AMHAR
  1.  F AMHX=7808:1:7809 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1.  .Q
  1. 7811 ;
  1.  K AMHAR
  1.  D ENP^XBDIQ1(9002011,AMHR,"7811;7812","AMHAR(","E")
  1.  S F=0 F  S F=$O(AMHAR(F)) Q:F'=+F  I AMHAR(F)]"" D
  1.  .S AMHH=$P(^DD(9002011,F,0),U)
  1.  .S AMHV=AMHAR(F)
  1.  .D BUILD1
  1. 7813 ;
  1.  K AMHAR
  1.  F AMHX=7813 I $D(^DD(9002011,AMHX,0)),$O(^AMHREC(AMHR,AMHX,0)) D
  1.  .S AMHSTR=$P(^DD(9002011,AMHX,0),U) D S(AMHSTR)
  1.  .K AMHAR D ENP^XBDIQ1(9002011,AMHR,AMHX,"AMHAR(","E")
  1.  .S F=0 F  S F=$O(AMHAR(AMHX,F)) Q:F'=+F  S AMHSTR=AMHAR(AMHX,F) D S(AMHSTR)
  1.  .S AMHSTR="" D S(AMHSTR)
  1.  .Q
  1. XIT ;
  1.  Q