source: FOIAVistA/trunk/r/DIETETICS-FH/FHWORA.m@ 1611

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

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1FHWORA ; HISC/GJC - OE/RR Procedure Call (Assessments) ;11/6/97 15:35
2 ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
3FHWORADT(DFN) ; Pass back the Assessment Dates for a particular patient.
4 ;----------------------------------------------------------------------
5 ; Input : DFN -> the ien of the patient
6 ; Output: -1^error text -> no assessments passed back with reason being
7 ; error text
8 ; 1 -> Assessments for our patient have been found. Data will
9 ; stored in:
10 ; ^TMP($J,"FHADT",DFN,inv internal dt/time)=ext dt/time
11 ;----------------------------------------------------------------------
12 Q:'$L(DFN) "-1^patient data missing"
13 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q "-1^patient data missing"
14 Q:'$D(^FHPT(FHDFN,0)) "-1^invalid patient (not in Dietetics Patient file)"
15 Q:'+$O(^FHPT(FHDFN,"N",0)) "-1^No assessments on file"
16 ;K ^TMP($J,"FHADT",DFN) N FH115A,I S I=6929298 ;7/1/2007
17 ;K ^TMP($J,"FHADT",DFN) N FH115A,I S I=6929398 ;6/1/2007
18 K ^TMP($J,"FHADT",DFN) N FH115A,I S I=6928998 ;10/1/2007
19 F S I=$O(^FHPT(FHDFN,"N",I)) Q:I'>0 D
20 . S FH115A=$G(^FHPT(FHDFN,"N",I,0))
21 . S ^TMP($J,"FHADT",DFN,I)=$$FMTE^XLFDT($P(FH115A,"^"),1)
22 . Q
23 Q $S($D(^TMP($J,"FHADT",DFN)):1,1:"-1^No assessments prior to 10/1/2007 on file")
24 ;
25FHWORASM(DFN,FHADTX) ; Store Assessment data so it can be displayed
26 ;----------------------------------------------------------------------
27 ; Input : DFN -> ien of the patient
28 ; FHADTX -> Assessment Date (external format)
29 ; Output: -1^error text, error text will be failure reason
30 ; 1, no error data to be stored in:
31 ; ^TMP($J,"FHASM",DFN,seq #)="lines of text"
32 ;----------------------------------------------------------------------
33 Q:'$L(DFN) "-1^patient data missing"
34 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q "-1^patient data missing"
35 Q:'$L(FHADTX) "-1^patient assessment date missing"
36 Q:+FHADTX=FHADTX "-1^expecting the external format for a date/time"
37 Q:'$D(^FHPT(FHDFN,0)) "-1^invalid patient (not in Dietetics Patient file)"
38 N FHADTI,FHADTINV D DT^DILF("T",FHADTX,.FHADTI)
39 Q:FHADTI=-1 "-1^invalid assessment date"
40 S FHADTINV=(9999999-FHADTI)
41 Q:'$D(^FHPT(FHDFN,"N",FHADTINV,0)) "-1^No assessments on file for this date/time"
42 K ^TMP($J,"FHASM",DFN)
43 N ACIR,ACIRP,ADT,AGE,AMP,BFAMA,BFAMAP,BMI,BMIP,CCIR,CCIRP,CNT,DTP,DWGT
44 N FHAPPER,FHASMNT,FHLAB,FHUNIT,FLD,FRM,HGP,HGT,I,IBW,KCAL,N,NAM,NB,PRO
45 N RC,SCA,SCAP,SEX,STR,STR1,TAB,TSF,TSFP,UWGT,WGP,WGT,X,X1,X2,X3,XD,Y,Z
46 S CNT=0
47 ; Note: '^FH(119.9,1' is the Dietetics Site Parameter file!
48 S FHUNIT=$P($G(^FH(119.9,1,3)),"^") ; Eng. or Metric units of measure
49 S FHASMNT(0)=$G(^FHPT(FHDFN,"N",FHADTINV,0))
50 F I=1:1:22 S @$P("ADT SEX AGE HGT HGP WGT WGP DWGT UWGT IBW FRM AMP X X X KCAL PRO FLD RC XD BMI BMIP"," ",I)=$P(FHASMNT(0),"^",I)
51 S SIGN=$P(FHASMNT(0),U,23) S:SIGN'="" SIGN1="Entered by: "_$P($P(^VA(200,SIGN,0),U),",",2)_" "_$P($P(^VA(200,SIGN,0),U),",") K SIGN
52 S NAM=$P(^DPT(DFN,0),"^"),NB=$P(FHASMNT(0),"^",25)
53 S SEX=$S(SEX="M":"Male",SEX="F":"Female",1:"")
54 S FHASMNT(1)=$G(^FHPT(FHDFN,"N",FHADTINV,1))
55 F I=1:1:10 S @$P("TSF TSFP SCA SCAP ACIR ACIRP CCIR CCIRP BFAMA BFAMAP"," ",I)=$P(FHASMNT(1),"^",I)
56 S FHAPPER=$G(^FHPT(FHDFN,"N",FHADTINV,2)),I=0
57 F S I=$O(^FHPT(FHDFN,"N",FHADTINV,"L",I)) Q:I'>0 S FHLAB(I)=$G(^(I,0))
58 D SETUP^FHWORA1
59 Q $S($D(^TMP($J,"FHASM",DFN)):1,1:"-1^No assessments on file for this date/time")
60 ;
61CNT(X) ; Increment our subscript
62 S X=X+1 S CNT=X
63 Q CNT
64 ;
65COMMENT ; Display the Nutritional Assessment comments.
66 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
67 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))="Comments"
68 S ^TMP($J,"FHASM",DFN,$$CNT^FHWORA(CNT))=" "
69 Q:'+$O(^FHPT(FHDFN,"N",FHADTINV,"X",0)) ; quit if no comments
70 N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,FHI,X
71 S DIWF="",DIWL=1,DIWR=79 K ^UTILITY($J,"W",DIWL) S FHI=0
72 F S FHI=$O(^FHPT(FHDFN,"N",FHADTINV,"X",FHI)) Q:FHI'>0 D
73 . S X=$G(^FHPT(FHDFN,"N",FHADTINV,"X",FHI,0)) D ^DIWP
74 . Q
75 S I=0 F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0 D
76 . S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=$G(^UTILITY($J,"W",DIWL,I,0))
77 . Q
78 K ^UTILITY($J,"W",DIWL)
79 Q
80 ;
81LAB(I) ; Display lab data for our patient.
82 S X1=$P(FHLAB(I),"^",7) Q:X1="" S DTP=X1\1 D DTP^FH
83 S:'X3 ^TMP($J,"FHASM",DFN,$$CNT(CNT))=" " ; initial linefeed
84 S X3=X3+1 ; lab data found? $S(X3>0:"Yes",1:"No")
85 K STR S $P(STR," ",81)="",TAB=5
86 S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^"))))=$P(FHLAB(I),"^")
87 S TAB=27
88 S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^",6))))=$P(FHLAB(I),"^",6)
89 S TAB=40
90 S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^",4))))=$P(FHLAB(I),"^",4)
91 S TAB=51
92 S $E(STR,(TAB+1),(TAB+$L($P(FHLAB(I),"^",5))))=$P(FHLAB(I),"^",5)
93 S TAB=65,$E(STR,(TAB+1),(TAB+$L(DTP)))=DTP
94 S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=STR
95 Q
96 ;
97TRUNC(I) ; Set each node to no more than eighty (80) chars in length.
98 N A,B,C S A=$L(I(0)),B=A\80
99 F C=1:1:B S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=$E(I(0),$S(C=1:1,1:((C-1)*80)),((C*80)-1))
100 S ^TMP($J,"FHASM",DFN,$$CNT(CNT))=$E(I(0),(((80*B)+1)-1),A)
101 Q
Note: See TracBrowser for help on using the repository browser.