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

BHSDEN0.m

Go to the documentation of this file.
  1. BHSDEN0 ;IHS/CIA/MGH - Health Summary for Dental ;17-Mar-2006 10:36;MGH
  1. ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006
  1. ;===================================================================
  1. ;Taken from ADERVW0
  1. ; IHS/HQT/MJL - DENTAL CHART REVW PT 2 ;09:34 PM [ 03/24/1999 9:04
  1. ;;6.0;ADE;;APRIL 1999
  1. ;Health summary for dental, printout of data
  1. PRTTXT ;EP
  1. S ADEDLT=1,ADEILN=IOM-ADEICL-1
  1. F ADEQ=0:0 S:ADENRQ]""&(($L(ADENRQ)+$L(ADETXT)+2)<255) ADETXT=$S(ADETXT]"":ADETXT_"; ",1:"")_ADENRQ,ADENRQ="" Q:ADETXT="" D PRTTXT2
  1. K ADEILN,ADEDLT,ADEF,ADEC,ADETXT
  1. Q
  1. PRTTXT2 D GETFRAG D CKP^GMTSUP Q:$D(GMTSSQIT) W ?ADEICL W ADEF,! S ADEICL=ADEICL+ADEDLT,ADEILN=ADEILN-ADEDLT,ADEDLT=0
  1. Q
  1. GETFRAG I $L(ADETXT)<ADEILN S ADEF=ADETXT,ADETXT="" Q
  1. F ADEC=ADEILN:-1:1 Q:$E(ADETXT,ADEC)=" "
  1. S ADEF=$E(ADETXT,1,ADEC-1),ADETXT=$E(ADETXT,ADEC+1,255)
  1. Q
  1. GETSITE ;EP
  1. S:ADESITE="" ADESITE="null"
  1. S %=$S($D(^AUTTLOC(ADESITE,0)):^(0),1:"")
  1. S ADENSH=$P(%,U,2) I ADENSH="" S ADENSH="<"_ADESITE_">"
  1. Q
  1. S ADEPG=ADEPG+1,ADEHD2=$P(^DPT(ADEPAT,0),U,1)_" (DENTAL SUMMARY) pg. "_ADEPG,%="",$P(%,"*",((IOM-4-$L(ADEHD2))\2)+1)="*",%=%_" "_ADEHD2_" "_%
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W !,ADEHDR,!,%,!
  1. Q
  1. ;
  1. BREAK S %="",$P(%,"-",IOM-3-$L(GMTSEGH_GMTSEGL)/2)="",%=%_" "_GMTSEGH_GMTSEGL_" "_% W !,%,!!
  1. Q