source: FOIAVistA/trunk/r/DIETETICS-FH/FHDSSAPI.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1FHDSSAPI ;Hines OIFO/RTK,JRC-DSS REQUESTED API's ;11/23/07 12:40pm
2 ;;5.5;DIETETICS;**7,11,10**;Jan 28, 2005;Build 5
3 ;11/22/2006 KAM/BAY Remedy Call 168346 Add Variable Cleanup from *7
4 ;
5DATA(FHSDT,FHEDT) ;API for DSS extract of NFS data
6 ; INPUT: START DATE, END DATE
7 ; OUTPUT: ^TMP($J,"FH"
8 ; Get inpatient meals
9 I FHSDT>FHEDT W !!,"END DATE BEFORE START DATE!",! H 1 Q
10 K ^TMP($J,"FH") S FHEDT=FHEDT_.99
11 F FHDFN=0:0 S FHDFN=$O(^FHPT(FHDFN)) Q:FHDFN'>0 F FHADM=0:0 S FHADM=$O(^FHPT(FHDFN,"A",FHADM)) Q:FHADM'>0 D
12 .I '$D(^FHPT(FHDFN,0)) Q
13 .; Quit if patient is deceased - DSS developer added lines DATA+9,10,13
14 .S FHDCEASE=$$GET1^DIQ(2,$P(^FHPT(FHDFN,0),U,3),".351","I")
15 .Q:FHDCEASE&(FHDCEASE<FHSDT)
16 .S FHZN=$G(^FHPT(FHDFN,"A",FHADM,0)),FHLAST=""
17 .S FHADTM=$P(FHZN,U,1) I FHADTM>FHEDT Q
18 .I '$P(FHZN,U,14),FHDCEASE S $P(FHZN,U,14)=FHDCEASE
19 .S FHDDTM=$P(FHZN,U,14) I FHDDTM'="",FHDDTM<FHSDT Q
20 .F FHDATE=0:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT) D
21 ..S FHDSEQ=$P($G(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE,0)),U,2)
22 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"DI",FHDSEQ,0))
23 ..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"INP")
24 ..S FHLAST=FHDATE
25 ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"INP")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
26 .; Get additional feedings for inpatient
27 .F FHDATE=0:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT) D
28 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE,0))
29 ..I FHDATE<FHSDT Q I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"EL")
30 ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"EL")=FHNODE
31 .S FHLAST="" F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"A",FHADM,"SF",FHSF)) Q:FHSF'>0 D
32 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SF",FHSF,0))
33 ..S FHDATE=$P(FHNODE,U,2) I FHDATE>FHEDT Q
34 ..S FHCDATE=$P(FHNODE,U,32) I FHCDATE'="" I FHCDATE<FHSDT Q
35 ..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"SF")
36 ..S FHLAST=FHDATE
37 ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"SF")=FHNODE
38 .S FHNUM=0 F FHSO=0:0 S FHSO=$O(^FHPT(FHDFN,"A",FHADM,"SP",FHSO)) Q:FHSO'>0 D
39 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SP",FHSO,0))
40 ..S FHDATE=$P(FHNODE,U,4) I FHDATE>FHEDT Q
41 ..S FHCDATE=$P(FHNODE,U,6) I FHCDATE'="" I FHCDATE<FHSDT Q
42 ..S FHNUM=FHNUM+1,^TMP($J,"FH",FHADM,FHDFN,FHDATE,"SO",FHNUM)=FHNODE
43 .S FHLAST="" F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF)) Q:FHTF'>0 D
44 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,0))
45 ..S FHDATE=$P(FHNODE,U,1) I FHDATE>FHEDT Q
46 ..S FHCDATE=$P(FHNODE,U,11) I FHCDATE'="" I FHCDATE<FHSDT Q
47 ..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"TF")
48 ..S FHLAST=FHDATE
49 ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"TF")=FHNODE
50 ..F FHTFPR=0:0 S FHTFPR=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR)) Q:FHTFPR'>0 D
51 ...S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR,0))
52 ...S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"TF",FHTFPR,"P")=FHNODE
53 ...Q
54 ..Q
55 .Q
56 ; Get outpatient meals
57 S X1=FHSDT,X2=-1 D C^%DTC S FHSDTX1=X_.99
58 ; Get recurring meals
59 F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("RM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT) D
60 .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHOMDT,FHDFN)) Q:FHDFN="" D
61 ..I '$D(^FHPT(FHDFN,0)) Q
62 ..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM="" D
63 ...S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0)) I $P(FHNODE,U,15)="C" Q
64 ...I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
65 ...S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
66 ...;
67 ...; IF NON-VA LOC DIET(S) ARE IN FIELDS DIET1-DIET5
68 ...;
69 ...I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
70 ....S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2)) I $P(FHNODE2,U,6)="C" Q
71 ....I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
72 ....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMEL")=FHNODE2 I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
73 ...I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
74 ....S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3)) I $P(FHNODE3,U,5)="C" Q
75 ....I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
76 ....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMTF")=FHNODE3 I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
77 ....F FHZ=0:0 S FHZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ)) Q:FHZ'>0 D
78 .....S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ,0))
79 .....S ^TMP($J,"FH",FHOMDT,FHDFN,FHRNUM,"RMTF",FHZ)=FHTUZN I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
80 ; Get special meals
81 F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("SM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT) D
82 .F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHOMDT,FHDFN)) Q:FHDFN="" D
83 ..I '$D(^FHPT(FHDFN,0)) Q
84 ..S FHNODE=$G(^FHPT(FHDFN,"SM",FHOMDT,0)) I $P(FHNODE,U,2)'="A" Q
85 ..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
86 ..S ^TMP($J,"FH",FHOMDT,FHDFN,"SM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
87 ; Get guest meals
88 F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("GM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT) D
89 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHOMDT,FHDFN)) Q:FHDFN="" D
90 ..I '$D(^FHPT(FHDFN,0)) Q
91 ..S FHNODE=$G(^FHPT(FHDFN,"GM",FHOMDT,0)) I $P(FHNODE,U,9)="C" Q
92 ..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
93 ..S ^TMP($J,"FH",FHOMDT,FHDFN,"GM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
94 K FHADM,FHDATE,FHDFN,FHDSEQ,FHEL,FHNODE,FHNODE2,FHNODE3,FHOMDT,FHRNUM
95 K FHSDTX1,FHSF,FHSFDT,FHSO,FHSODT,FHTF,FHTFDT,FHTFPR,FHTUZN,FHZ,FHZN
96 K FHCDATE,FHNUM,FHEFF,FHADTM,FHDDTM,FHLAST,X,X1,X2,FHDCEASE
97 Q
Note: See TracBrowser for help on using the repository browser.