Changeset 636 for FOIAVistA/tag/r/DIETETICS-FH/FHDSSAPI.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DIETETICS-FH/FHDSSAPI.m (modified) (6 diffs)

FOIAVistA/tag/r/DIETETICS-FH/FHDSSAPI.m

@@ -1 @@
-FHDSSAPI ;Hines OIFO/RTK,JRC-DSS REQUESTED API's  ;11/23/07 12:40pm
- ;;5.5;DIETETICS;**7,11,10**;Jan 28, 2005;Build 5
+FHDSSAPI ;Hines OIFO/RTK-DSS REQUESTED API's  ;3/08/06  10:15
+ ;;5.5;DIETETICS;**7,11**;Jan 28, 2005;Build 4
  ;11/22/2006 KAM/BAY Remedy Call 168346 Add Variable Cleanup from *7
  ;
@@ -9 +9 @@
  I FHSDT>FHEDT W !!,"END DATE BEFORE START DATE!",! H 1 Q
  K ^TMP($J,"FH") S FHEDT=FHEDT_.99
- 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
- .I '$D(^FHPT(FHDFN,0)) Q
- .; Quit if patient is deceased - DSS developer added lines DATA+9,10,13
- .S FHDCEASE=$$GET1^DIQ(2,$P(^FHPT(FHDFN,0),U,3),".351","I")
- .Q:FHDCEASE&(FHDCEASE<FHSDT)
- .S FHZN=$G(^FHPT(FHDFN,"A",FHADM,0)),FHLAST=""
- .S FHADTM=$P(FHZN,U,1) I FHADTM>FHEDT Q
- .I '$P(FHZN,U,14),FHDCEASE S $P(FHZN,U,14)=FHDCEASE
- .S FHDDTM=$P(FHZN,U,14) I FHDDTM'="",FHDDTM<FHSDT Q
- .F FHDATE=0:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT)  D
- ..S FHDSEQ=$P($G(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE,0)),U,2)
- ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"DI",FHDSEQ,0))
- ..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"INP")
- ..S FHLAST=FHDATE
- ..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)
- .; Get additional feedings for inpatient
- .F FHDATE=0:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT)  D
- ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"EL",FHDATE,0))
- ..I FHDATE<FHSDT Q  I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"EL")
- ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"EL")=FHNODE
- .S FHLAST="" F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"A",FHADM,"SF",FHSF)) Q:FHSF'>0  D
- ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SF",FHSF,0))
- ..S FHDATE=$P(FHNODE,U,2) I FHDATE>FHEDT Q
- ..S FHCDATE=$P(FHNODE,U,32) I FHCDATE'="" I FHCDATE<FHSDT Q
- ..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"SF")
- ..S FHLAST=FHDATE
- ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"SF")=FHNODE
- .S FHNUM=0 F FHSO=0:0 S FHSO=$O(^FHPT(FHDFN,"A",FHADM,"SP",FHSO)) Q:FHSO'>0  D
- ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SP",FHSO,0))
- ..S FHDATE=$P(FHNODE,U,4) I FHDATE>FHEDT Q
- ..S FHCDATE=$P(FHNODE,U,6) I FHCDATE'="" I FHCDATE<FHSDT Q
- ..S FHNUM=FHNUM+1,^TMP($J,"FH",FHADM,FHDFN,FHDATE,"SO",FHNUM)=FHNODE
- .S FHLAST="" F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF)) Q:FHTF'>0  D
- ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,0))
- ..S FHDATE=$P(FHNODE,U,1) I FHDATE>FHEDT Q
- ..S FHCDATE=$P(FHNODE,U,11) I FHCDATE'="" I FHCDATE<FHSDT Q
- ..I FHDATE<FHSDT I FHLAST'="" K ^TMP($J,"FH",FHADM,FHDFN,FHLAST,"TF")
- ..S FHLAST=FHDATE
- ..S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"TF")=FHNODE
+ 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  F FHDATE=FHSDT:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT)  D
+ .S FHDSEQ=$P($G(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE,0)),U,2)
+ .S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"DI",FHDSEQ,0))
+ .S ^TMP($J,"FH",FHDATE,FHDFN,FHADM,"INP")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
+ ; Get additional feedings for inpatient
+ 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  D
+ .F FHEL=FHSDT:0 S FHEL=$O(^FHPT(FHDFN,"A",FHADM,"EL",FHEL)) Q:FHEL'>0!(FHEL>FHEDT)  D
+ ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"EL",FHEL,0))
+ ..S ^TMP($J,"FH",FHEL,FHDFN,FHADM,"EL")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
+ .F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"A",FHADM,"SF",FHSF)) Q:FHSF'>0  D
+ ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SF",FHSF,0)),FHSFDT=$P(FHNODE,U,2)
+ ..I FHSFDT<FHSDT!(FHSFDT>FHEDT) Q
+ ..S ^TMP($J,"FH",FHSFDT,FHDFN,FHADM,"SF")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
+ .F FHSO=0:0 S FHSO=$O(^FHPT(FHDFN,"A",FHADM,"SP",FHSO)) Q:FHSO'>0  D
+ ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SP",FHSO,0)),FHSODT=$P(FHNODE,U,4)
+ ..I FHSODT<FHSDT!(FHSODT>FHEDT) Q
+ ..S ^TMP($J,"FH",FHSODT,FHDFN,FHADM,"SO")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
+ .F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF)) Q:FHTF'>0  D
+ ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,0)),FHTFDT=$P(FHNODE,U,1)
+ ..I FHTFDT<FHSDT!(FHTFDT>FHEDT) Q
+ ..S ^TMP($J,"FH",FHTFDT,FHDFN,FHADM,"TF")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
  ..F FHTFPR=0:0 S FHTFPR=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR)) Q:FHTFPR'>0  D
  ...S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR,0))
- ...S ^TMP($J,"FH",FHADM,FHDFN,FHDATE,"TF",FHTFPR,"P")=FHNODE
- ...Q
+ ...S ^TMP($J,"FH",FHTFDT,FHDFN,FHADM,"TF",FHTFPR,"P")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
  ..Q
  .Q
@@ -59 +40 @@
  F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("RM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT)  D
  .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHOMDT,FHDFN)) Q:FHDFN=""  D
- ..I '$D(^FHPT(FHDFN,0)) Q
  ..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM=""  D
  ...S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0)) I $P(FHNODE,U,15)="C" Q
@@ -65 +45 @@
  ...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)
  ...;
- ...; IF NON-VA LOC DIET(S) ARE IN FIELDS DIET1-DIET5
+ ...; SHOULD LET DSS KNOW DIETS COULD BE IN FIELDS DIET1-5 IF NONVA LOC
  ...;
  ...I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
@@ -81 +61 @@
  F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("SM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT)  D
  .F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHOMDT,FHDFN)) Q:FHDFN=""  D
- ..I '$D(^FHPT(FHDFN,0)) Q
  ..S FHNODE=$G(^FHPT(FHDFN,"SM",FHOMDT,0)) I $P(FHNODE,U,2)'="A" Q
  ..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
@@ -88 +67 @@
  F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("GM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT)  D
  .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHOMDT,FHDFN)) Q:FHDFN=""  D
- ..I '$D(^FHPT(FHDFN,0)) Q
  ..S FHNODE=$G(^FHPT(FHDFN,"GM",FHOMDT,0)) I $P(FHNODE,U,9)="C" Q
  ..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
  ..S ^TMP($J,"FH",FHOMDT,FHDFN,"GM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
  K FHADM,FHDATE,FHDFN,FHDSEQ,FHEL,FHNODE,FHNODE2,FHNODE3,FHOMDT,FHRNUM
- K FHSDTX1,FHSF,FHSFDT,FHSO,FHSODT,FHTF,FHTFDT,FHTFPR,FHTUZN,FHZ,FHZN
- K FHCDATE,FHNUM,FHEFF,FHADTM,FHDDTM,FHLAST,X,X1,X2,FHDCEASE
+ K FHSDTX1,FHSF,FHSFDT,FHSO,FHSODT,FHTF,FHTFDT,FHTFPR,FHTUZN,FHZ,X,X1,X2
  Q