GMTSPXFP ; SLC/SBW,KER - PCE Health Factors Component ; 2/22/07 1:52pm
;;2.7;Health Summary;**8,10,28,56,58,62,69,82**;Oct 20, 1995;Build 21
;
; 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,GMW,GMTSHFO Q:$O(GMTSEG(GMTSEGN,9999999.64,0))'>0
S GMTSFC=0,GMW=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,GMTSEND,GMTSBEG,GMTSNDM,.HFSEG)
Q:'$D(^TMP("PXF",$J)) D REORD D CKP^GMTSUP Q:$D(GMTSQIT) D SELECT
Q
REORD ; Re-Order Selected Health Factors
N GMTSI,GMTSHFI,GMTSCAT,GMTSHFT,GMTSMCAT,GMTSHF,GMTSHFC 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 GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSMCAT_","),.01) Q:'$L(GMTSCAT)
. . S GMTSHFI=0 F S GMTSHFI=$O(^AUTTHF("AC",+GMTSMCAT,GMTSHFI)) Q:+GMTSHFI=0 D
. . . S GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01) Q:'$L(GMTSHF)
. . . S GMTSHFC=+($O(^TMP("GMTSPXO",$J," "),-1))+1,^TMP("GMTSPXO",$J,GMTSHFC,GMTSCAT,GMTSHF)=""
. Q:'$L(GMTSCAT) S GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01) Q:'$L(GMTSHF)
. S GMTSHFC=+($O(^TMP("GMTSPXO",$J," "),-1))+1,^TMP("GMTSPXO",$J,GMTSHFC,GMTSCAT,GMTSHF)=""
Q
HFACT ; Control Health Factor retrieval and display
K ^TMP("PXF",$J) D HF^PXRHS07(DFN,GMTSEND,GMTSBEG,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,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT,GMICL,GMTAB,GMTSLN,GMTSFRST S GMHFC="",GMW=0,GMTSFRST=0
F S GMHFC=$O(^TMP("PXF",$J,GMHFC)) Q:GMHFC="" D Q:$D(GMTSQIT)
. S GMHF="" F S GMHF=$O(^TMP("PXF",$J,GMHFC,GMHF)) Q:GMHF="" D Q:$D(GMTSQIT)
. . D BYDT
K ^TMP("PXF",$J),^TMP("GMTSPXO",$J) W:GMTSFRST=0 " No data available",!
Q
SELECT ; Display Selected Health Factors
N GMO,GMHFC,GMHF,GMDT,GMIFN,GMN0,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT,GMICL,GMTAB,GMTSLN,GMTSFRST S GMHFC="",GMW=0,PHFC="",GMTSFRST=0
S GMO=0 F S GMO=$O(^TMP("GMTSPXO",$J,GMO)) Q:+GMO=0 D Q:$D(GMTSQIT)
. S GMHFC="" F S GMHFC=$O(^TMP("GMTSPXO",$J,GMO,GMHFC)) Q:'$L(GMHFC) D Q:$D(GMTSQIT)
. . S GMHF="" F S GMHF=$O(^TMP("GMTSPXO",$J,GMO,GMHFC,GMHF)) Q:'$L(GMHF) D Q:$D(GMTSQIT)
. . . D BYDT
K ^TMP("PXF",$J),^TMP("GMTSPXO",$J) W:GMTSFRST=0 " No Data Available",!
Q
BYDT ; Display Health Factors by Date
N GMDT,GMIFN S GMDT=0 F S GMDT=$O(^TMP("PXF",$J,GMHFC,GMHF,GMDT)) Q:GMDT'>0 D Q:$D(GMTSQIT)
. S GMIFN=0 F S GMIFN=$O(^TMP("PXF",$J,GMHFC,GMHF,GMDT,GMIFN)) Q:GMIFN'>0 D Q:$D(GMTSQIT)
. . D HFDSP Q:$D(GMTSQIT)
Q
HDR ; Display Header
N GMTSRN Q:$D(GMTSOBJ) Q:$D(GMTSQIT)
D CKP^GMTSUP Q:$D(GMTSQIT) W "Category",!
D CKP^GMTSUP Q:$D(GMTSQIT) W " Health Factor ",?50,"Visit Date",! W:GMTSFRST=1 !
Q
HFDSP ; Display Data
N GMTSRN,GMTSIEN
;VMP/RJT -- HD67936 -- HEALTH FACTORS 'DISPLAY ON HEALTH SUMMARY' PARAMETER CHECK
S GMTSIEN=$$FIND1^DIC(9999999.64,"","X",GMHF,"B",""),GMTSRN=$$GET1^DIQ(9999999.64,GMTSIEN,.08,"I")
Q:GMTSRN'="Y"
I GMTSFRST=0 D HDR S GMTSFRST=1
S GMN0=$G(^TMP("PXF",$J,GMHFC,GMHF,GMDT,GMIFN,0))
Q:GMN0']""
S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDAT=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 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
. . W GMHFC,! S PHFC=GMHFC
. S GMW=1
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?2,HF
W:LEVEL]"" " (",LEVEL,")"
W ?50,GMTSDAT,!
S COMMENT="",COMMENT=$P(^TMP("PXF",$J,GMHFC,GMHF,GMDT,GMIFN,"COM"),U)
I COMMENT]"" S GMICL=13,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 ?13,^UTILITY($J,"W",DIWL,GMTSLN,0),!
Q
GMTSPXFP ; SLC/SBW,KER - PCE Health Factors Component ; 2/22/07 1:52pm
+1 ;;2.7;Health Summary;**8,10,28,56,58,62,69,82**;Oct 20, 1995;Build 21
+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,GMW,GMTSHFO
IF $ORDER(GMTSEG(GMTSEGN,9999999.64,0))'>0
QUIT
+2 SET GMTSFC=0
SET GMW=0
KILL ^TMP("PXF",$JOB),^TMP("GMTSPXO",$JOB)
+3 FOR
SET GMTSFC=$ORDER(GMTSEG(GMTSEGN,9999999.64,GMTSFC))
IF 'GMTSFC
QUIT
Begin DoDot:1
+4 SET HFSEG(GMTSEG(GMTSEGN,9999999.64,GMTSFC))=""
End DoDot:1
+5 KILL ^TMP("PXF",$JOB)
DO HF^PXRHS07(DFN,GMTSEND,GMTSBEG,GMTSNDM,.HFSEG)
+6 IF '$DATA(^TMP("PXF",$JOB))
QUIT
DO REORD
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
DO SELECT
+7 QUIT
REORD ; Re-Order Selected Health Factors
+1 NEW GMTSI,GMTSHFI,GMTSCAT,GMTSHFT,GMTSMCAT,GMTSHF,GMTSHFC
KILL GMTSHFO
+2 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSEG(GMTSEGN,9999999.64,GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+3 SET GMTSHFI=$GET(GMTSEG(GMTSEGN,9999999.64,GMTSI))
+4 SET GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.03)
+5 SET GMTSHFT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.1,"I")
IF '$LENGTH(GMTSHFT)
QUIT
+6 IF GMTSHFT="C"
Begin DoDot:2
+7 NEW GMTSCAT,GMTSMCAT
SET GMTSMCAT=GMTSHFI
NEW GMTSHFI
+8 SET GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSMCAT_","),.01)
IF '$LENGTH(GMTSCAT)
QUIT
+9 SET GMTSHFI=0
FOR
SET GMTSHFI=$ORDER(^AUTTHF("AC",+GMTSMCAT,GMTSHFI))
IF +GMTSHFI=0
QUIT
Begin DoDot:3
+10 SET GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01)
IF '$LENGTH(GMTSHF)
QUIT
+11 SET GMTSHFC=+($ORDER(^TMP("GMTSPXO",$JOB," "),-1))+1
SET ^TMP("GMTSPXO",$JOB,GMTSHFC,GMTSCAT,GMTSHF)=""
End DoDot:3
End DoDot:2
QUIT
+12 IF '$LENGTH(GMTSCAT)
QUIT
SET GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01)
IF '$LENGTH(GMTSHF)
QUIT
+13 SET GMTSHFC=+($ORDER(^TMP("GMTSPXO",$JOB," "),-1))+1
SET ^TMP("GMTSPXO",$JOB,GMTSHFC,GMTSCAT,GMTSHF)=""
End DoDot:1
+14 QUIT
HFACT ; Control Health Factor retrieval and display
+1 KILL ^TMP("PXF",$JOB)
DO HF^PXRHS07(DFN,GMTSEND,GMTSBEG,GMTSNDM)
IF '$DATA(^TMP("PXF",$JOB))
QUIT
+2 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
DO HFMAIN
+3 QUIT
HFMAIN ; Display Health Factors
+1 NEW GMHFC,GMHF,GMDT,GMIFN,GMN0,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT,GMICL,GMTAB,GMTSLN,GMTSFRST
SET GMHFC=""
SET GMW=0
SET GMTSFRST=0
+2 FOR
SET GMHFC=$ORDER(^TMP("PXF",$JOB,GMHFC))
IF GMHFC=""
QUIT
Begin DoDot:1
+3 SET GMHF=""
FOR
SET GMHF=$ORDER(^TMP("PXF",$JOB,GMHFC,GMHF))
IF GMHF=""
QUIT
Begin DoDot:2
+4 DO BYDT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+5 KILL ^TMP("PXF",$JOB),^TMP("GMTSPXO",$JOB)
IF GMTSFRST=0
WRITE " No data available",!
+6 QUIT
SELECT ; Display Selected Health Factors
+1 NEW GMO,GMHFC,GMHF,GMDT,GMIFN,GMN0,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT,GMICL,GMTAB,GMTSLN,GMTSFRST
SET GMHFC=""
SET GMW=0
SET PHFC=""
SET GMTSFRST=0
+2 SET GMO=0
FOR
SET GMO=$ORDER(^TMP("GMTSPXO",$JOB,GMO))
IF +GMO=0
QUIT
Begin DoDot:1
+3 SET GMHFC=""
FOR
SET GMHFC=$ORDER(^TMP("GMTSPXO",$JOB,GMO,GMHFC))
IF '$LENGTH(GMHFC)
QUIT
Begin DoDot:2
+4 SET GMHF=""
FOR
SET GMHF=$ORDER(^TMP("GMTSPXO",$JOB,GMO,GMHFC,GMHF))
IF '$LENGTH(GMHF)
QUIT
Begin DoDot:3
+5 DO BYDT
End DoDot:3
IF $DATA(GMTSQIT)
QUIT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+6 KILL ^TMP("PXF",$JOB),^TMP("GMTSPXO",$JOB)
IF GMTSFRST=0
WRITE " No Data Available",!
+7 QUIT
BYDT ; Display Health Factors by Date
+1 NEW GMDT,GMIFN
SET GMDT=0
FOR
SET GMDT=$ORDER(^TMP("PXF",$JOB,GMHFC,GMHF,GMDT))
IF GMDT'>0
QUIT
Begin DoDot:1
+2 SET GMIFN=0
FOR
SET GMIFN=$ORDER(^TMP("PXF",$JOB,GMHFC,GMHF,GMDT,GMIFN))
IF GMIFN'>0
QUIT
Begin DoDot:2
+3 DO HFDSP
IF $DATA(GMTSQIT)
QUIT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+4 QUIT
HDR ; Display Header
+1 NEW GMTSRN
IF $DATA(GMTSOBJ)
QUIT
IF $DATA(GMTSQIT)
QUIT
+2 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE "Category",!
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE " Health Factor ",?50,"Visit Date",!
IF GMTSFRST=1
WRITE !
+4 QUIT
HFDSP ; Display Data
+1 NEW GMTSRN,GMTSIEN
+2 ;VMP/RJT -- HD67936 -- HEALTH FACTORS 'DISPLAY ON HEALTH SUMMARY' PARAMETER CHECK
+3 SET GMTSIEN=$$FIND1^DIC(9999999.64,"","X",GMHF,"B","")
SET GMTSRN=$$GET1^DIQ(9999999.64,GMTSIEN,.08,"I")
+4 IF GMTSRN'="Y"
QUIT
+5 IF GMTSFRST=0
DO HDR
SET GMTSFRST=1
+6 SET GMN0=$GET(^TMP("PXF",$JOB,GMHFC,GMHF,GMDT,GMIFN,0))
+7 IF GMN0']""
QUIT
+8 SET X=$PIECE(GMN0,U,2)
DO REGDT4^GMTSU
SET GMTSDAT=X
+9 SET HF=$PIECE(GMN0,U)
SET LEVEL=$PIECE(GMN0,U,4)
+10 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
DO HDR
Begin DoDot:1
+11 IF GMHFC'=$GET(PHFC)!GMTSNPG
Begin DoDot:2
+12 IF '$DATA(GMTSOBJ)
IF $GET(PHFC)=""
IF 'GMTSNPG
WRITE !
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+13 WRITE GMHFC,!
SET PHFC=GMHFC
End DoDot:2
+14 SET GMW=1
End DoDot:1
+15 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+16 WRITE ?2,HF
+17 IF LEVEL]""
WRITE " (",LEVEL,")"
+18 WRITE ?50,GMTSDAT,!
+19 SET COMMENT=""
SET COMMENT=$PIECE(^TMP("PXF",$JOB,GMHFC,GMHF,GMDT,GMIFN,"COM"),U)
+20 IF COMMENT]""
SET GMICL=13
SET GMTAB=2
DO FORMAT
IF $DATA(^UTILITY($JOB,"W"))
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
Begin DoDot:1
+21 FOR GMTSLN=1:1:^UTILITY($JOB,"W",DIWL)
DO LINE
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
+22 QUIT
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
LINE ; Write Line
+1 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?13,^UTILITY($JOB,"W",DIWL,GMTSLN,0),!
+2 QUIT
