source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPXFP.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1GMTSPXFP ; SLC/SBW,KER - PCE Health Factors Component ; 02/11/2003 [1/7/04 1:48pm]
2 ;;2.7;Health Summary;**8,10,28,56,58,62,69**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 1243 HF^PXRHS07
6 ; DBIA 4295 $$GET1^DIQ (file #9999999.64, .01)
7 ; DBIA 4295 $$GET1^DIQ (file #9999999.64, .03)
8 ; DBIA 4295 $$GET1^DIQ (file #9999999.64), .1)
9 ; DBIA 4295 ^AUTTHF("AC")
10 ; DBIA 10011 ^DIWP
11 ;
12HFSEL ; Health Factors Selected
13 N HFSEG,GMTSFC,GMW,GMTSHFO Q:$O(GMTSEG(GMTSEGN,9999999.64,0))'>0
14 S GMTSFC=0,GMW=0 K ^TMP("PXF",$J),^TMP("GMTSPXO",$J)
15 F S GMTSFC=$O(GMTSEG(GMTSEGN,9999999.64,GMTSFC)) Q:'GMTSFC D
16 . S HFSEG(GMTSEG(GMTSEGN,9999999.64,GMTSFC))=""
17 K ^TMP("PXF",$J) D HF^PXRHS07(DFN,GMTSEND,GMTSBEG,GMTSNDM,.HFSEG)
18 Q:'$D(^TMP("PXF",$J)) D REORD D CKP^GMTSUP Q:$D(GMTSQIT) D HDR,SELECT
19 Q
20REORD ; Re-Order Selected Health Factors
21 N GMTSI,GMTSHFI,GMTSCAT,GMTSHFT,GMTSMCAT,GMTSHF,GMTSHFC K GMTSHFO
22 S GMTSI=0 F S GMTSI=$O(GMTSEG(GMTSEGN,9999999.64,GMTSI)) Q:+GMTSI=0 D
23 . S GMTSHFI=$G(GMTSEG(GMTSEGN,9999999.64,GMTSI))
24 . S GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.03)
25 . S GMTSHFT=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.1,"I") Q:'$L(GMTSHFT)
26 . I GMTSHFT="C" D Q
27 . . N GMTSCAT,GMTSMCAT S GMTSMCAT=GMTSHFI N GMTSHFI
28 . . S GMTSCAT=$$GET1^DIQ(9999999.64,(GMTSMCAT_","),.01) Q:'$L(GMTSCAT)
29 . . S GMTSHFI=0 F S GMTSHFI=$O(^AUTTHF("AC",+GMTSMCAT,GMTSHFI)) Q:+GMTSHFI=0 D
30 . . . S GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01) Q:'$L(GMTSHF)
31 . . . S GMTSHFC=+($O(^TMP("GMTSPXO",$J," "),-1))+1,^TMP("GMTSPXO",$J,GMTSHFC,GMTSCAT,GMTSHF)=""
32 . Q:'$L(GMTSCAT) S GMTSHF=$$GET1^DIQ(9999999.64,(GMTSHFI_","),.01) Q:'$L(GMTSHF)
33 . S GMTSHFC=+($O(^TMP("GMTSPXO",$J," "),-1))+1,^TMP("GMTSPXO",$J,GMTSHFC,GMTSCAT,GMTSHF)=""
34 Q
35HFACT ; Control Health Factor retrieval and display
36 K ^TMP("PXF",$J) D HF^PXRHS07(DFN,GMTSEND,GMTSBEG,GMTSNDM) Q:'$D(^TMP("PXF",$J))
37 D CKP^GMTSUP Q:$D(GMTSQIT) D HDR,HFMAIN
38 Q
39HFMAIN ; Display Health Factors
40 N GMHFC,GMHF,GMDT,GMIFN,GMN0,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT,GMICL,GMTAB,GMTSLN S GMHFC="",GMW=0
41 F S GMHFC=$O(^TMP("PXF",$J,GMHFC)) Q:GMHFC="" D Q:$D(GMTSQIT)
42 . S GMHF="" F S GMHF=$O(^TMP("PXF",$J,GMHFC,GMHF)) Q:GMHF="" D Q:$D(GMTSQIT)
43 . . D BYDT
44 K ^TMP("PXF",$J),^TMP("GMTSPXO",$J)
45 Q
46SELECT ; Display Selected Health Factors
47 N GMO,GMHFC,GMHF,GMDT,GMIFN,GMN0,GMW,X,GMTSDAT,HF,LEVEL,PHFC,COMMENT,GMICL,GMTAB,GMTSLN S GMHFC="",GMW=0,PHFC=""
48 S GMO=0 F S GMO=$O(^TMP("GMTSPXO",$J,GMO)) Q:+GMO=0 D Q:$D(GMTSQIT)
49 . S GMHFC="" F S GMHFC=$O(^TMP("GMTSPXO",$J,GMO,GMHFC)) Q:'$L(GMHFC) D Q:$D(GMTSQIT)
50 . . S GMHF="" F S GMHF=$O(^TMP("GMTSPXO",$J,GMO,GMHFC,GMHF)) Q:'$L(GMHF) D Q:$D(GMTSQIT)
51 . . . D BYDT
52 K ^TMP("PXF",$J),^TMP("GMTSPXO",$J)
53 Q
54BYDT ; Display Health Factors by Date
55 N GMDT,GMIFN S GMDT=0 F S GMDT=$O(^TMP("PXF",$J,GMHFC,GMHF,GMDT)) Q:GMDT'>0 D Q:$D(GMTSQIT)
56 . S GMIFN=0 F S GMIFN=$O(^TMP("PXF",$J,GMHFC,GMHF,GMDT,GMIFN)) Q:GMIFN'>0 D Q:$D(GMTSQIT)
57 . . D HFDSP Q:$D(GMTSQIT)
58 Q
59HDR ; Display Header
60 Q:$D(GMTSOBJ) Q:$D(GMTSQIT)
61 D CKP^GMTSUP Q:$D(GMTSQIT) W "Category",!
62 D CKP^GMTSUP Q:$D(GMTSQIT) W " Health Factor ",?50,"Visit Date",!
63 Q
64HFDSP ; Display Data
65 S GMN0=$G(^TMP("PXF",$J,GMHFC,GMHF,GMDT,GMIFN,0))
66 Q:GMN0']""
67 S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDAT=X
68 S HF=$P(GMN0,U),LEVEL=$P(GMN0,U,4)
69 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR D
70 . I GMHFC'=$G(PHFC)!GMTSNPG D
71 . . I '$D(GMTSOBJ),$G(PHFC)="",'GMTSNPG W ! D CKP^GMTSUP Q:$D(GMTSQIT)
72 . . W GMHFC,! S PHFC=GMHFC
73 . S GMW=1
74 D CKP^GMTSUP Q:$D(GMTSQIT)
75 W ?2,HF
76 W:LEVEL]"" " (",LEVEL,")"
77 W ?50,GMTSDAT,!
78 S COMMENT="",COMMENT=$P(^TMP("PXF",$J,GMHFC,GMHF,GMDT,GMIFN,"COM"),U)
79 I COMMENT]"" S GMICL=13,GMTAB=2 D FORMAT I $D(^UTILITY($J,"W")) D CKP^GMTSUP Q:$D(GMTSQIT) D
80 . F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
81 Q
82FORMAT ; Format Line
83 N DIWR,DIWF,X
84 S DIWL=3,DIWR=80-(GMICL+GMTAB)
85 K ^UTILITY($J,"W")
86 S X=COMMENT D ^DIWP
87 Q
88LINE ; Write Line
89 D CKP^GMTSUP Q:$D(GMTSQIT) W ?13,^UTILITY($J,"W",DIWL,GMTSLN,0),!
90 Q
Note: See TracBrowser for help on using the repository browser.