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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPXFP 5698 printed Dec 13, 2024@01:59:48 Page 2
GMTSPXFP ; SLC/SBW,KER,PKR - PCE Health Factors Component ; 05/27/2022
+1 ;;2.7;Health Summary;**8,10,28,56,58,62,69,82,110,122,115**;Oct 20, 1995;Build 190
+2 ;
+3 ; External References
+4 ; DBIA 1243 HF^PXRHS07
+5 ; DBIA 4295 $$GET1^DIQ (file #9999999.64, .01)
+6 ; DBIA 4295 $$GET1^DIQ (file #9999999.64, .03)
+7 ; DBIA 4295 $$GET1^DIQ (file #9999999.64, .08)
+8 ; DBIA 4295 $$GET1^DIQ (file #9999999.64), .1)
+9 ; DBIA 4295 ^AUTTHF("AC")
+10 ; DBIA 10011 ^DIWP
+11 ;
HFSEL ; Health Factors Selected
+1 NEW HFSEG,GMTSFC,GMTSHFO
+2 if $ORDER(GMTSEG(GMTSEGN,9999999.64,0))'>0
QUIT
+3 SET GMTSFC=0
+4 KILL ^TMP("PXF",$JOB),^TMP("GMTSPXO",$JOB)
+5 FOR
SET GMTSFC=$ORDER(GMTSEG(GMTSEGN,9999999.64,GMTSFC))
if 'GMTSFC
QUIT
Begin DoDot:1
+6 SET HFSEG(GMTSEG(GMTSEGN,9999999.64,GMTSFC))=""
End DoDot:1
+7 KILL ^TMP("PXF",$JOB)
DO HF^PXRHS07(DFN,GMTSBEG,GMTSEND,GMTSNDM,.HFSEG)
+8 if '$DATA(^TMP("PXF",$JOB))
QUIT
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
DO SELECT
+9 ;Q:'$D(^TMP("PXF",$J)) D REORD D CKP^GMTSUP Q:$D(GMTSQIT) D SELECT
+10 QUIT
+11 ;
REORD ; Re-Order Selected Health Factors by Category.
+1 ;GMTS*2.7*115 - Reorder is not needed, PXRSH07 returns
+2 ;health factors ordered by Category.
+3 NEW GMTSI,GMTSHFI,GMTSCAT,GMTSHFT,GMTSMCAT
+4 KILL GMTSHFO
+5 SET GMTSI=0
+6 FOR
SET GMTSI=$ORDER(GMTSEG(GMTSEGN,9999999.64,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+7 SET GMTSHFI=$GET(GMTSEG(GMTSEGN,9999999.64,GMTSI))
+8 SET GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.03)
+9 SET GMTSHFT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.1,"I")
if '$LENGTH(GMTSHFT)
QUIT
+10 IF GMTSHFT="C"
Begin DoDot:2
+11 ;N GMTSCAT,GMTSMCAT S GMTSMCAT=GMTSHFI N GMTSHFI
+12 SET GMTSMCAT=GMTSHFI
+13 SET GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSMCAT_","),.01)
if '$LENGTH(GMTSCAT)
QUIT
+14 SET ^TMP("GMTSPXO",$JOB,GMTSCAT)=""
End DoDot:2
QUIT
+15 if '$LENGTH(GMTSCAT)
QUIT
SET GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01)
if '$LENGTH(GMTSHF)
QUIT
+16 SET ^TMP("GMTSPXO",$JOB,GMTSCAT)=""
End DoDot:1
+17 QUIT
+18 ;
HFACT ; Control Health Factor retrieval and display
+1 KILL ^TMP("PXF",$JOB)
DO HF^PXRHS07(DFN,GMTSBEG,GMTSEND,GMTSNDM)
if '$DATA(^TMP("PXF",$JOB))
QUIT
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
DO HFMAIN
+3 QUIT
+4 ;
HFMAIN ; Display Health Factors
+1 NEW GMHFC,GMHF,GMDT,GMIFN,GMN0,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT
+2 NEW GMICL,GMTAB,GMTSLN,GMTSFRST
+3 SET GMHFC=""
SET GMTSFRST=0
+4 FOR
SET GMHFC=$ORDER(^TMP("PXF",$JOB,GMHFC))
if GMHFC=""
QUIT
Begin DoDot:1
+5 SET GMDT=0
+6 FOR
SET GMDT=+$ORDER(^TMP("PXF",$JOB,GMHFC,GMDT))
if GMDT=0
QUIT
Begin DoDot:2
+7 DO BYNM(GMDT)
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 KILL ^TMP("PXF",$JOB),^TMP("GMTSPXO",$JOB)
if GMTSFRST=0
WRITE " No data available",!
+9 QUIT
+10 ;
SELECT ; Display Selected Health Factors
+1 NEW GMHFC,GMTSFRST
+2 SET GMHFC=""
SET GMTSFRST=0
+3 FOR
SET GMHFC=$ORDER(^TMP("PXF",$JOB,GMHFC))
if '$LENGTH(GMHFC)
QUIT
Begin DoDot:1
+4 DO BYDT(GMHFC)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+5 ;F S GMHFC=$O(^TMP("GMTSPXO",$J,GMHFC)) Q:'$L(GMHFC) D Q:$D(GMTSQIT)
+6 ;. D BYDT(GMHFC)
+7 KILL ^TMP("PXF",$JOB),^TMP("GMTSPXO",$JOB)
if GMTSFRST=0
WRITE " No Data Available",!
+8 QUIT
+9 ;
BYDT(GMHFC) ; Display Health Factors by Date
+1 NEW GMDT,GMHF,GMIFN,WDATE
+2 SET GMDT=0
+3 FOR
SET GMDT=+$ORDER(^TMP("PXF",$JOB,GMHFC,GMDT))
if GMDT=0
QUIT
Begin DoDot:1
+4 SET GMHF=""
SET WDATE=1
+5 FOR
SET GMHF=$ORDER(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF))
if GMHF=""
QUIT
Begin DoDot:2
+6 SET GMIFN=0
+7 FOR
SET GMIFN=$ORDER(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF,GMIFN))
if GMIFN'>0
QUIT
Begin DoDot:3
+8 DO HFDSP(WDATE,GMIFN)
if $DATA(GMTSQIT)
QUIT
End DoDot:3
if $DATA(GMTSQIT)
QUIT
+9 SET WDATE=0
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 QUIT
+11 ;
BYNM(GMDT) ; Display Health Factors with the same date by Name
+1 NEW GMIFN,GMHF,WDATE
+2 SET GMHF=""
SET WDATE=1
+3 FOR
SET GMHF=$ORDER(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF))
if GMHF=""
QUIT
Begin DoDot:1
+4 SET GMIFN=0
+5 FOR
SET GMIFN=$ORDER(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF,GMIFN))
if GMIFN'>0
QUIT
Begin DoDot:2
+6 DO HFDSP(WDATE,GMIFN)
if $DATA(GMTSQIT)
QUIT
+7 SET WDATE=0
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 QUIT
+9 ;
HDR ; Display Header
+1 ;KDM 1/28/2014 GMTS*2.7*110
+2 ;Change header from "Visit Date" to "Event/Visit Date" to reduce
+3 ;ambiguity as it can be either date.
+4 NEW GMTSRN
if $DATA(GMTSOBJ)
QUIT
if $DATA(GMTSQIT)
QUIT
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE "Event/Visit",?13,"Category"
+7 WRITE !,?3,"Date",?15,"Health Factor",!!
+8 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+9 QUIT
+10 ;
HFDSP(WDATE,GMIFN) ; Display Data
+1 NEW GMTSRN,GMTSIEN,TEXT
+2 IF GMTSFRST=0
DO HDR
SET GMTSFRST=1
+3 SET GMN0=$GET(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF,GMIFN,0))
+4 if GMN0']""
QUIT
+5 SET X=$PIECE(GMN0,U,2)
DO REGDT4^GMTSU
SET GMTSDATE=X
+6 SET HF=$PIECE(GMN0,U)
SET LEVEL=$PIECE(GMN0,U,4)
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
Begin DoDot:1
+8 IF GMHFC'=$GET(PHFC)!GMTSNPG
Begin DoDot:2
+9 IF '$DATA(GMTSOBJ)
IF $GET(PHFC)=""
IF 'GMTSNPG
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+10 WRITE ?13,GMHFC,!
SET PHFC=GMHFC
End DoDot:2
End DoDot:1
+11 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+12 IF WDATE=1
WRITE GMTSDATE
+13 SET TEXT=HF
+14 IF LEVEL'=""
SET TEXT=TEXT_" ("_LEVEL_")"
+15 IF $LENGTH(TEXT)<65
WRITE ?15,TEXT,!
+16 IF '$TEST
DO LONGTEXT(TEXT)
+17 IF $GET(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF,GMIFN,"MEASUREMENT"))'=""
Begin DoDot:1
+18 NEW MAGNITUDE,MEAS,UCUMDISPLAY,UCUMFIELD,UCUMIEN,UNITS
+19 SET MEAS=^TMP("PXF",$JOB,GMHFC,GMDT,GMHF,GMIFN,"MEASUREMENT")
+20 SET MAGNITUDE=$PIECE(MEAS,U,1)
+21 IF MAGNITUDE=""
QUIT
+22 SET UCUMIEN=$PIECE(MEAS,U,2)
+23 IF UCUMIEN'=""
Begin DoDot:2
+24 SET UCUMDISPLAY=$PIECE(MEAS,U,3)
+25 IF UCUMDISPLAY="N"
SET UNITS=""
QUIT
+26 SET UCUMFIELD=$SELECT(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
+27 SET UNITS=$$UCUMFIELDS^GMTSUCUM(UCUMIEN,UCUMFIELD)
End DoDot:2
+28 IF '$TEST
SET UNITS=""
+29 IF UNITS=""
SET TEXT=" Magnitude: "
+30 IF '$TEST
SET TEXT=" Measurement: "
+31 SET TEXT=TEXT_MAGNITUDE
+32 IF UNITS'=""
SET TEXT=TEXT_" "_UNITS
+33 IF $LENGTH(TEXT)<65
WRITE ?15,TEXT,!
+34 IF '$TEST
DO LONGTEXT(TEXT)
End DoDot:1
+35 SET COMMENT=""
SET COMMENT=$PIECE(^TMP("PXF",$JOB,GMHFC,GMDT,GMHF,GMIFN,"COM"),U)
+36 IF COMMENT]""
SET GMICL=16
SET GMTAB=2
DO FORMAT
IF $DATA(^UTILITY($JOB,"W"))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
Begin DoDot:1
+37 FOR GMTSLN=1:1:^UTILITY($JOB,"W",DIWL)
DO LINE
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+38 QUIT
+39 ;
FORMAT ; Format Line
+1 NEW DIWR,DIWF,X
+2 SET DIWL=3
SET DIWR=80-(GMICL+GMTAB)
+3 KILL ^UTILITY($JOB,"W")
+4 SET X=COMMENT
DO ^DIWP
+5 QUIT
+6 ;
LINE ; Write Line
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?16,^UTILITY($JOB,"W",DIWL,GMTSLN,0),!
+2 QUIT
+3 ;
LONGTEXT(TEXT) ;
+1 NEW BPT,IND
+2 SET BPT=64
+3 FOR IND=64:-1
if (BPT<64)!(IND=1)
QUIT
IF $EXTRACT(TEXT,IND)=" "
SET BPT=IND
+4 WRITE ?15,$EXTRACT(TEXT,1,BPT),!
+5 WRITE ?15,$EXTRACT(TEXT,(BPT+1),$LENGTH(TEXT)),!
+6 QUIT
+7 ;
