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

GMTSPXFP.m

Go to the documentation of this file.
GMTSPXFP ; SLC/SBW,KER,PKR - PCE Health Factors Component ; 05/27/2022

 ;;2.7;Health Summary;**8,10,28,56,58,62,69,82,110,122,115**;Oct 20, 1995;Build 190

 ;

 ; External References

 ;   DBIA   1243  HF^PXRHS07

 ;   DBIA   4295  $$GET1^DIQ  (file #9999999.64, .01)

 ;   DBIA   4295  $$GET1^DIQ  (file #9999999.64, .03)

 ;   DBIA   4295  $$GET1^DIQ  (file #9999999.64, .08)

 ;   DBIA   4295  $$GET1^DIQ  (file #9999999.64), .1)

 ;   DBIA   4295  ^AUTTHF("AC")

 ;   DBIA  10011  ^DIWP

 ;                    

HFSEL ; Health Factors Selected

 N HFSEG,GMTSFC,GMTSHFO

 Q:$O(GMTSEG(GMTSEGN,9999999.64,0))'>0

 S GMTSFC=0

 K ^TMP("PXF",$J),^TMP("GMTSPXO",$J)

 F  S GMTSFC=$O(GMTSEG(GMTSEGN,9999999.64,GMTSFC)) Q:'GMTSFC  D

 . S HFSEG(GMTSEG(GMTSEGN,9999999.64,GMTSFC))=""

 K ^TMP("PXF",$J) D HF^PXRHS07(DFN,GMTSBEG,GMTSEND,GMTSNDM,.HFSEG)

 Q:'$D(^TMP("PXF",$J))  D CKP^GMTSUP Q:$D(GMTSQIT)  D SELECT

 ;Q:'$D(^TMP("PXF",$J))  D REORD D CKP^GMTSUP Q:$D(GMTSQIT)  D SELECT

 Q

 ;

REORD ; Re-Order Selected Health Factors by Category.

 ;GMTS*2.7*115 - Reorder is not needed, PXRSH07 returns

 ;health factors ordered by Category.

 N GMTSI,GMTSHFI,GMTSCAT,GMTSHFT,GMTSMCAT

 K GMTSHFO

 S GMTSI=0

 F  S GMTSI=$O(GMTSEG(GMTSEGN,9999999.64,GMTSI)) Q:+GMTSI=0  D

 . S GMTSHFI=$G(GMTSEG(GMTSEGN,9999999.64,GMTSI))

 . S GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.03)

 . S GMTSHFT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.1,"I") Q:'$L(GMTSHFT)

 . I GMTSHFT="C" D  Q

 .. ;N GMTSCAT,GMTSMCAT S GMTSMCAT=GMTSHFI N GMTSHFI

 .. S GMTSMCAT=GMTSHFI

 .. S GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSMCAT_","),.01) Q:'$L(GMTSCAT)

 .. S ^TMP("GMTSPXO",$J,GMTSCAT)=""

 . Q:'$L(GMTSCAT)  S GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01) Q:'$L(GMTSHF)

 . S ^TMP("GMTSPXO",$J,GMTSCAT)=""

 Q

 ;

HFACT ; Control Health Factor retrieval and display

 K ^TMP("PXF",$J) D HF^PXRHS07(DFN,GMTSBEG,GMTSEND,GMTSNDM) Q:'$D(^TMP("PXF",$J))

 D CKP^GMTSUP Q:$D(GMTSQIT)  D HFMAIN

 Q

 ;

HFMAIN ; Display Health Factors

 N GMHFC,GMHF,GMDT,GMIFN,GMN0,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT

 N GMICL,GMTAB,GMTSLN,GMTSFRST

 S GMHFC="",GMTSFRST=0

 F  S GMHFC=$O(^TMP("PXF",$J,GMHFC)) Q:GMHFC=""  D  Q:$D(GMTSQIT)

 . S GMDT=0

 . F  S GMDT=+$O(^TMP("PXF",$J,GMHFC,GMDT)) Q:GMDT=0  D  Q:$D(GMTSQIT)

 .. D BYNM(GMDT)

 K ^TMP("PXF",$J),^TMP("GMTSPXO",$J) W:GMTSFRST=0 " No data available",!

 Q

 ;

SELECT ; Display Selected Health Factors

 N GMHFC,GMTSFRST

 S GMHFC="",GMTSFRST=0

 F  S GMHFC=$O(^TMP("PXF",$J,GMHFC)) Q:'$L(GMHFC)  D  Q:$D(GMTSQIT)

 . D BYDT(GMHFC)

 ;F  S GMHFC=$O(^TMP("GMTSPXO",$J,GMHFC)) Q:'$L(GMHFC)  D  Q:$D(GMTSQIT)

 ;. D BYDT(GMHFC)

 K ^TMP("PXF",$J),^TMP("GMTSPXO",$J) W:GMTSFRST=0 " No Data Available",!

 Q

 ;

BYDT(GMHFC) ; Display Health Factors by Date

 N GMDT,GMHF,GMIFN,WDATE

 S GMDT=0

 F  S GMDT=+$O(^TMP("PXF",$J,GMHFC,GMDT)) Q:GMDT=0  D  Q:$D(GMTSQIT)

 . S GMHF="",WDATE=1

 . F  S GMHF=$O(^TMP("PXF",$J,GMHFC,GMDT,GMHF)) Q:GMHF=""  D  Q:$D(GMTSQIT)

 .. S GMIFN=0

 .. F  S GMIFN=$O(^TMP("PXF",$J,GMHFC,GMDT,GMHF,GMIFN)) Q:GMIFN'>0  D  Q:$D(GMTSQIT)

 ... D HFDSP(WDATE,GMIFN) Q:$D(GMTSQIT)

 .. S WDATE=0

 Q

 ;

BYNM(GMDT) ; Display Health Factors with the same date by Name

 N GMIFN,GMHF,WDATE

 S GMHF="",WDATE=1

 F  S GMHF=$O(^TMP("PXF",$J,GMHFC,GMDT,GMHF)) Q:GMHF=""  D  Q:$D(GMTSQIT)

 . S GMIFN=0

 . F  S GMIFN=$O(^TMP("PXF",$J,GMHFC,GMDT,GMHF,GMIFN)) Q:GMIFN'>0  D  Q:$D(GMTSQIT)

 .. D HFDSP(WDATE,GMIFN) Q:$D(GMTSQIT)

 .. S WDATE=0

 Q

 ;

HDR ; Display Header

 ;KDM 1/28/2014 GMTS*2.7*110 

 ;Change header from "Visit Date" to "Event/Visit Date" to reduce

 ;ambiguity as it can be either date.

 N GMTSRN Q:$D(GMTSOBJ)  Q:$D(GMTSQIT)

 D CKP^GMTSUP Q:$D(GMTSQIT)

 W "Event/Visit",?13,"Category"

 W !,?3,"Date",?15,"Health Factor",!!

 D CKP^GMTSUP Q:$D(GMTSQIT)

 Q

 ;

HFDSP(WDATE,GMIFN) ; Display Data

 N GMTSRN,GMTSIEN,TEXT

 I GMTSFRST=0 D HDR S GMTSFRST=1

 S GMN0=$G(^TMP("PXF",$J,GMHFC,GMDT,GMHF,GMIFN,0))

 Q:GMN0']""

 S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDATE=X

 S HF=$P(GMN0,U),LEVEL=$P(GMN0,U,4)

 D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HDR D

 . I GMHFC'=$G(PHFC)!GMTSNPG D

 .. I '$D(GMTSOBJ),$G(PHFC)="",'GMTSNPG D CKP^GMTSUP Q:$D(GMTSQIT)

 .. W ?13,GMHFC,! S PHFC=GMHFC

 D CKP^GMTSUP Q:$D(GMTSQIT)

 I WDATE=1 W GMTSDATE

 S TEXT=HF

 I LEVEL'="" S TEXT=TEXT_" ("_LEVEL_")"

 I $L(TEXT)<65 W ?15,TEXT,!

 E  D LONGTEXT(TEXT)

 I $G(^TMP("PXF",$J,GMHFC,GMDT,GMHF,GMIFN,"MEASUREMENT"))'="" D

 . N MAGNITUDE,MEAS,UCUMDISPLAY,UCUMFIELD,UCUMIEN,UNITS

 . S MEAS=^TMP("PXF",$J,GMHFC,GMDT,GMHF,GMIFN,"MEASUREMENT")

 . S MAGNITUDE=$P(MEAS,U,1)

 . I MAGNITUDE="" Q

 . S UCUMIEN=$P(MEAS,U,2)

 . I UCUMIEN'="" D

 .. S UCUMDISPLAY=$P(MEAS,U,3)

 .. I UCUMDISPLAY="N" S UNITS="" Q

 .. S UCUMFIELD=$S(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")

 .. S UNITS=$$UCUMFIELDS^GMTSUCUM(UCUMIEN,UCUMFIELD)

 . E  S UNITS=""

 . I UNITS="" S TEXT="  Magnitude: "

 . E  S TEXT="  Measurement: "

 . S TEXT=TEXT_MAGNITUDE

 . I UNITS'="" S TEXT=TEXT_" "_UNITS

 . I $L(TEXT)<65 W ?15,TEXT,!

 . E  D LONGTEXT(TEXT)

 S COMMENT="",COMMENT=$P(^TMP("PXF",$J,GMHFC,GMDT,GMHF,GMIFN,"COM"),U)

 I COMMENT]"" S GMICL=16,GMTAB=2 D FORMAT I $D(^UTILITY($J,"W")) D CKP^GMTSUP Q:$D(GMTSQIT)  D

 . F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)

 Q

 ;

FORMAT ; Format Line

 N DIWR,DIWF,X

 S DIWL=3,DIWR=80-(GMICL+GMTAB)

 K ^UTILITY($J,"W")

 S X=COMMENT D ^DIWP

 Q

 ;

LINE ; Write Line

 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?16,^UTILITY($J,"W",DIWL,GMTSLN,0),!

 Q

 ;

LONGTEXT(TEXT) ;

 N BPT,IND

 S BPT=64

 F IND=64:-1  Q:(BPT<64)!(IND=1)  I $E(TEXT,IND)=" " S BPT=IND

 W ?15,$E(TEXT,1,BPT),!

 W ?15,$E(TEXT,(BPT+1),$L(TEXT)),!

 Q

 ;