- 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
