Changeset 623 for WorldVistAEHR/trunk/r/DIETETICS-FH/FHDSSAPI.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- 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 1 FHDSSAPI ;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 ; 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 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.