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

GMTSPXEP.m

Go to the documentation of this file.
  1. GMTSPXEP ; SLC/SBW,KER,PKR - PCE Patient Education comp ; 04/15/2022
  1. ;;2.7;Health Summary;**8,10,28,35,56,122,115**;Oct 20, 1995;Build 190
  1. ;
  1. ; External References
  1. ; DBIA 3063 EDUC^PXRHS08
  1. ; DBIA 10011 ^DIWP
  1. ;
  1. PTED ; Patient Education
  1. N GMTSOVT K ^TMP("PXPE",$J) S GMTSOVT="AICTSORXHDE"
  1. ;
  1. ; GMTSOVT is a sting containing a set of Service
  1. ; Categories for:
  1. ;
  1. ; Ambulatory A
  1. ; Inpatient I
  1. ; Chart Review C
  1. ; Telecommunications T
  1. ; Day Surgery S
  1. ; Observation O
  1. ; Nursing Home R
  1. ; Ancillary X
  1. ; Hospitalization H
  1. ; Daily Hospitalization Ancillary D
  1. ; Event-Historical E
  1. ;
  1. D EDUC^PXRHS08(DFN,GMTSBEG,GMTSEND,GMTSNDM,GMTSOVT)
  1. Q:'$D(^TMP("PXPE",$J)) D CKP^GMTSUP Q:$D(GMTSQIT) D HDR,EDMAIN
  1. Q
  1. ;
  1. MRPTED ; Most recent patient education
  1. N GMTSOVT K ^TMP("PXPE",$J) S GMTSOVT="AICTSORXHDE"
  1. ;
  1. ; Returns most recent Patient Education Topic Types
  1. ; for time period. GMTSOVT is a sting containing a
  1. ; set of Service Categories for:
  1. ;
  1. ; Ambulatory A
  1. ; Inpatient I
  1. ; Chart Review C
  1. ; Telecommunications T
  1. ; Day Surgery S
  1. ; Observation O
  1. ; Nursing Home R
  1. ; Ancillary X
  1. ; Hospitalization H
  1. ; Daily Hospitalization Ancillary D
  1. ; Event-Historical E
  1. ;
  1. D EDUC^PXRHS08(DFN,GMTSBEG,GMTSEND,1,GMTSOVT)
  1. Q:'$D(^TMP("PXPE",$J))
  1. D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
  1. D EDMAIN
  1. Q
  1. ;
  1. HDR ; Header
  1. W "Event/Visit",?12,"Facility",?25,"Topic - Understanding Level"
  1. W !,?3,"Date",!!
  1. Q
  1. ;
  1. EDMAIN ; Main Education Display
  1. N COMMENT,ED,GMDT,GMED,GMICL,GMIFN,GMN0,GMN1,GMTSDATE,GMSITE
  1. N GMTSLN,GMTAB,LEVEL,LTXT,PSITE,PDT,TEXT,X
  1. S GMDT=0
  1. F S GMDT=$O(^TMP("PXPE",$J,GMDT)) Q:GMDT'>0 D Q:$D(GMTSQIT)
  1. . S GMED=""
  1. . F S GMED=$O(^TMP("PXPE",$J,GMDT,GMED)) Q:GMED']"" D Q:$D(GMTSQIT)
  1. . . S GMIFN=0
  1. . . F S GMIFN=$O(^TMP("PXPE",$J,GMDT,GMED,GMIFN)) Q:GMIFN'>0 D Q:$D(GMTSQIT)
  1. . . . S GMN0=$G(^TMP("PXPE",$J,GMDT,GMED,GMIFN,0))
  1. . . . Q:GMN0']""
  1. . . . S GMN1=$G(^TMP("PXPE",$J,GMDT,GMED,GMIFN,1))
  1. . . . S GMSITE=$S($P(GMN1,U,3)]"":$E($P(GMN1,U,3),1,10),$P(GMN1,U,4)]"":$E($P(GMN1,U,4),1,10),1:"No Site")
  1. . . . S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDATE=X
  1. . . . S LTXT="",ED=$P(GMN0,U),LEVEL=$P(GMN0,U,3)
  1. . . . I LEVEL]"" S LTXT=" - "_LEVEL
  1. . . . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
  1. . . . I GMTSDATE'=$G(PDT)!GMTSNPG W GMTSDATE S PDT=GMTSDATE,PSITE=""
  1. . . . I GMSITE'=$G(PSITE) W ?12,GMSITE S PSITE=GMSITE
  1. . . . S TEXT=ED_$G(LTXT)
  1. . . . I $L(TEXT)<56 W ?25,TEXT,!
  1. . . . E D LONGTEXT(TEXT)
  1. . . . I $G(^TMP("PXPE",$J,GMDT,GMED,GMIFN,"MEASUREMENT"))'="" D
  1. . . . . N MAGNITUDE,MEAS,UCUMDISPLAY,UCUMFIELD,UCUMIEN,UNITS
  1. . . . . S MEAS=^TMP("PXPE",$J,GMDT,GMED,GMIFN,"MEASUREMENT")
  1. . . . . S MAGNITUDE=$P(MEAS,U,1)
  1. . . . . I MAGNITUDE="" Q
  1. . . . . S UCUMIEN=$P(MEAS,U,2)
  1. . . . . I UCUMIEN'="" D
  1. . . . . . S UCUMDISPLAY=$P(MEAS,U,3)
  1. . . . . . I UCUMDISPLAY="N" S UNITS="" Q
  1. . . . . . S UCUMFIELD=$S(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
  1. . . . . . S UNITS=$$UCUMFIELDS^GMTSUCUM(UCUMIEN,UCUMFIELD)
  1. . . . . E S UNITS=""
  1. . . . . I UNITS="" S TEXT=" Magnitude: "
  1. . . . . E S TEXT=" Measurement: "
  1. . . . . S TEXT=TEXT_MAGNITUDE
  1. . . . . I UNITS'="" S TEXT=TEXT_" "_UNITS
  1. . . . . I $L(TEXT)<56 W ?25,TEXT,!
  1. . . . . E D LONGTEXT(TEXT)
  1. . . . S COMMENT=$P(^TMP("PXPE",$J,GMDT,GMED,GMIFN,"COM"),U,1)
  1. . . . I COMMENT]"" S GMICL=26,GMTAB=2 D FORMAT I $D(^UTILITY($J,"W")) D
  1. . . . . F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
  1. K ^TMP("PXPE",$J)
  1. Q
  1. ;
  1. FORMAT ; Format Line
  1. N DIWR,DIWF,X S DIWL=3,DIWR=80-(GMICL+GMTAB)
  1. K ^UTILITY($J,"W") S X=COMMENT D ^DIWP
  1. Q
  1. ;
  1. LINE ; Write Line
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?26,^UTILITY($J,"W",DIWL,GMTSLN,0),!
  1. Q
  1. ;
  1. LONGTEXT(TEXT) ;
  1. N BPT,IND
  1. S BPT=55
  1. F IND=55:-1 Q:(BPT<55)!(IND=1) I $E(TEXT,IND)=" " S BPT=IND
  1. W ?25,$E(TEXT,1,BPT),!
  1. W ?25,$E(TEXT,(BPT+1),$L(TEXT)),!
  1. Q
  1. ;