Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/DIETETICS-FH/FHDSSAPI.m

    r613 r623  
    1 FHDSSAPI        ;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         ;
    5 DATA(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
     1FHDSSAPI ;Hines OIFO/RTK-DSS REQUESTED API's  ;3/08/06  10:15
     2 ;;5.5;DIETETICS;**7,11**;Jan 28, 2005;Build 4
     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  F FHDATE=FHSDT:0 S FHDATE=$O(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE)) Q:FHDATE'>0!(FHDATE>FHEDT)  D
     12 .S FHDSEQ=$P($G(^FHPT(FHDFN,"A",FHADM,"AC",FHDATE,0)),U,2)
     13 .S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"DI",FHDSEQ,0))
     14 .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)
     15 ; Get additional feedings for inpatient
     16 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
     17 .F FHEL=FHSDT:0 S FHEL=$O(^FHPT(FHDFN,"A",FHADM,"EL",FHEL)) Q:FHEL'>0!(FHEL>FHEDT)  D
     18 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"EL",FHEL,0))
     19 ..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)
     20 .F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"A",FHADM,"SF",FHSF)) Q:FHSF'>0  D
     21 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SF",FHSF,0)),FHSFDT=$P(FHNODE,U,2)
     22 ..I FHSFDT<FHSDT!(FHSFDT>FHEDT) Q
     23 ..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)
     24 .F FHSO=0:0 S FHSO=$O(^FHPT(FHDFN,"A",FHADM,"SP",FHSO)) Q:FHSO'>0  D
     25 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"SP",FHSO,0)),FHSODT=$P(FHNODE,U,4)
     26 ..I FHSODT<FHSDT!(FHSODT>FHEDT) Q
     27 ..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)
     28 .F FHTF=0:0 S FHTF=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF)) Q:FHTF'>0  D
     29 ..S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,0)),FHTFDT=$P(FHNODE,U,1)
     30 ..I FHTFDT<FHSDT!(FHTFDT>FHEDT) Q
     31 ..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)
     32 ..F FHTFPR=0:0 S FHTFPR=$O(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR)) Q:FHTFPR'>0  D
     33 ...S FHNODE=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHTF,"P",FHTFPR,0))
     34 ...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)
     35 ..Q
     36 .Q
     37 ; Get outpatient meals
     38 S X1=FHSDT,X2=-1 D C^%DTC S FHSDTX1=X_.99
     39 ; Get recurring meals
     40 F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("RM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT)  D
     41 .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHOMDT,FHDFN)) Q:FHDFN=""  D
     42 ..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM=""  D
     43 ...S FHNODE=$G(^FHPT(FHDFN,"OP",FHRNUM,0)) I $P(FHNODE,U,15)="C" Q
     44 ...I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
     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)
     46 ...;
     47 ...; SHOULD LET DSS KNOW DIETS COULD BE IN FIELDS DIET1-5 IF NONVA LOC
     48 ...;
     49 ...I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D
     50 ....S FHNODE2=$G(^FHPT(FHDFN,"OP",FHRNUM,2)) I $P(FHNODE2,U,6)="C" Q
     51 ....I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
     52 ....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)
     53 ...I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D
     54 ....S FHNODE3=$G(^FHPT(FHDFN,"OP",FHRNUM,3)) I $P(FHNODE3,U,5)="C" Q
     55 ....I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
     56 ....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)
     57 ....F FHZ=0:0 S FHZ=$O(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ)) Q:FHZ'>0  D
     58 .....S FHTUZN=$G(^FHPT(FHDFN,"OP",FHRNUM,"TF",FHZ,0))
     59 .....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)
     60 ; Get special meals
     61 F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("SM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT)  D
     62 .F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHOMDT,FHDFN)) Q:FHDFN=""  D
     63 ..S FHNODE=$G(^FHPT(FHDFN,"SM",FHOMDT,0)) I $P(FHNODE,U,2)'="A" Q
     64 ..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
     65 ..S ^TMP($J,"FH",FHOMDT,FHDFN,"SM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
     66 ; Get guest meals
     67 F FHOMDT=FHSDTX1:0 S FHOMDT=$O(^FHPT("GM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHEDT)  D
     68 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHOMDT,FHDFN)) Q:FHDFN=""  D
     69 ..S FHNODE=$G(^FHPT(FHDFN,"GM",FHOMDT,0)) I $P(FHNODE,U,9)="C" Q
     70 ..I $P($G(^FHPT(FHDFN,0)),U,3)="" Q
     71 ..S ^TMP($J,"FH",FHOMDT,FHDFN,"GM")=FHNODE I '$D(^TMP($J,"FH","ZN",FHDFN)) S ^TMP($J,"FH","ZN",FHDFN)=^FHPT(FHDFN,0)
     72 K FHADM,FHDATE,FHDFN,FHDSEQ,FHEL,FHNODE,FHNODE2,FHNODE3,FHOMDT,FHRNUM
     73 K FHSDTX1,FHSF,FHSFDT,FHSO,FHSODT,FHTF,FHTFDT,FHTFPR,FHTUZN,FHZ,X,X1,X2
     74 Q
Note: See TracChangeset for help on using the changeset viewer.