Changeset 636 for FOIAVistA/tag/r/DIETETICS-FH

Timestamp:

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

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DIETETICS-FH/FHASP1.m (modified) (2 diffs)
• DIETETICS-FH/FHDSSAPI.m (modified) (6 diffs)
• DIETETICS-FH/FHNO2.m (modified) (2 diffs)
• DIETETICS-FH/FHOMPP.m (modified) (3 diffs)
• DIETETICS-FH/FHORC5.m (modified) (1 diff)
• DIETETICS-FH/FHPRO.m (modified) (2 diffs)
• DIETETICS-FH/FHPRW.m (modified) (2 diffs)
• DIETETICS-FH/FHREP1.m (modified) (2 diffs)
• DIETETICS-FH/FHSELA1.m (modified) (2 diffs)
• DIETETICS-FH/FHSELA2.m (modified) (2 diffs)

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

@@ -1 +1 @@
 FHASP1 ; HISC/REL/JH - Nutrition Profile (cont) ;5/2/01  10:14
- ;;5.5;DIETETICS;**8,9**;Jan 28, 2005;Build 7
+ ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
  ;
  I '$G(FHET) S X="T-365",%DT="XT" D ^%DT S FHET=Y K %DT
@@ -63 +63 @@
  F KK=35:-1:1 Q:$E(X,KK-1,KK)=", "
  W $E(X,1,KK-2) S X=$E(X,KK+1,999) Q
-SP Q:'$P(X,U)  S M1=$P(X,"^",2) S:M1="A"!(M1="") M1="BNE" S Z=$G(^FH(115.2,+X,0)) Q:$P(Z,U)=""!($P(Z,U,2)="")  S L1=$P(Z,"^",1),KK=$P(Z,"^",2),M="",DAS=$P(X,"^",4)
+SP Q:'$P(X,U)  S M1=$P(X,"^",2) S:M1="A" M1="BNE" S Z=$G(^FH(115.2,+X,0)) Q:$P(Z,U)=""!($P(Z,U,2)="")  S L1=$P(Z,"^",1),KK=$P(Z,"^",2),M="",DAS=$P(X,"^",4)
  I KK="L" S Q=$P(X,"^",3),L1=$S(Q:Q,1:1)_" "_L1
  I M1="BNE" S M="1~All Meals" G SP1

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

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

@@ -1 +1 @@
 FHNO2 ; HISC/REL/NCA - Supplemental Feeding Labels ;8/26/94  12:01 
- ;;5.5;DIETETICS;**5,13**;Jan 28, 2005;Build 1
+ ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
  ;patch #5 - add outpatient SFs.
 D0 R !!,"Select by S=SUPPLEMENTAL FEEDING SITE or W=WARD: ",XX:DTIME G:'$T!("^"[XX) KIL I "sw"[XX S X=XX D TR^FH S XX=X
@@ -89 +89 @@
  .S FHODAT=$G(^FHPT(FHDFN,"OP",ADM,0)),FHNO=$P($G(^FHPT(FHDFN,"OP",ADM,"SF",0)),U,3) Q:'$G(FHNO)
  .S FHMEAL=$P(FHODAT,U,4),FHOWARD=$P(FHODAT,U,3)
- .S X1=$G(^FH(119.6,FHOWARD,0))
+ .S X1=$G(^FH(119.6,FHOWARD,0)),WRDN=$P(X1,U,1)
  .Q:'FHOWARD!'$D(^FH(119.6,FHOWARD,0))
  .I XX="W",W1 Q:W1'=FHOWARD
- .S WRDN=$P(X1,U,1)
  .I XX="S" S D2=$P(X1,"^",9) Q:D1'=D2  I D1=D2 S P0=$P(X1,"^",4),P0=$S(P0<1:99,P0<10:"0"_P0,1:P0)
  .S P1=$S(FHMEAL="N":13,FHMEAL="E":21,1:5)

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

@@ -1 @@
-FHOMPP ; OIFO/RTK - Patient Profile for Outpatients ;7/2/2007
- ;;5.5;DIETETICS;**9**;Jan 28, 2005;Build 7
+FHOMPP ; OIFO/RTK - Patient Profile for Outpatients ;6/23/03  1:04
+ ;;5.5;DIETETICS;;Jan 28, 2005
  D DEV Q
 DEV ;get device and set up queue
@@ -49 +49 @@
  ; Data is returned in ^TMP($J,"FHPROF",DFN,FHX)
  S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q "-1^Invalid outpatient"
- K ^TMP($J,"FHPROF"),^TMP($J,"L"),^TMP($J,"D") S (FHX,N)=0 D PATNAME^FHOMUTL
+ K ^TMP($J,"FHPROF",DFN) S (FHX,N)=0 D PATNAME^FHOMUTL
  S FHB="" F I=1:1:80 S FHB=FHB_" "
  S ^TMP($J,"FHPROF",DFN,FHX)="OUTPATIENT NAME: "_FHPTNM_"   "_FHSSN
@@ -67 +67 @@
  I $D(^TMP($J,"L")) S N=1 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)="Likes"
  S FHM="" F  S FHM=$O(^TMP($J,"L",FHM)) Q:FHM=""  D
- .F FHP=0:0 S FHP=$O(^TMP($J,"L",FHM,FHP)) Q:FHP'>0  S N=0 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"L",FHM,FHP)
+ .F FHP=0:0 S FHP=$O(^TMP($J,"L",FHM,FHP)) Q:FHP'>0  S N=0 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"L",FHM,FHP) Q
  I $D(^TMP($J,"D")) S N=1 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)="Dislikes"
  S FHM="" F  S FHM=$O(^TMP($J,"D",FHM)) Q:FHM=""  D
- .F FHP=0:0 S FHP=$O(^TMP($J,"D",FHM,FHP)) Q:FHP'>0  S N=0 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"D",FHM,FHP)
+ .F FHP=0:0 S FHP=$O(^TMP($J,"D",FHM,FHP)) Q:FHP'>0  S N=0 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)=^TMP($J,"D",FHM,FHP) Q
  ;
  S N=1 D NEWL S ^TMP($J,"FHPROF",DFN,FHX)="Recurring Meals on File: "

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

@@ -1 +1 @@
 FHORC5 ; HISC/REL - Consult Management ;4/12/06  13:26
- ;;5.5;DIETETICS;**4,12**;Jan 28, 2005;Build 3
- ; 10/17/2007 BP/KAM FH*5.5*12 Rem Call 210883 Remove Old Clinician Field (#1)
+ ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
 EN9 ; Enter/Edit Ward Assignments
  K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQM"
  W ! D ^DIC G KIL:U[X!$D(DTOUT),EN9:Y<1 S OLD=$S($P(Y,"^",3):"",1:$P(^FH(119.6,+Y,0),"^",2))
- ; 10/17/2007 BP/KAM *12 Rem Call 210883 Removed field #1 in next line
- S DA=+Y,DR="112" D ^DIE S NEW=$P(^FH(119.6,DA,0),"^",2) I 'NEW!('OLD) K OLD,NEW,X,Y G EN9
+ S DA=+Y,DR="1;112" D ^DIE S NEW=$P(^FH(119.6,DA,0),"^",2) I 'NEW!('OLD) K OLD,NEW,X,Y G EN9
  D:OLD'=NEW EN2^FHORC4 K OLD,NEW,X,Y G EN9
 EN10 ; List Ward Assignments

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

@@ -1 +1 @@
 FHPRO ; HISC/REL/RTK - Food Production Manager ;4/12/06  15:53
- ;;5.5;DIETETICS;**4,5,12**;Jan 28, 2005;Build 3
- ;
- ; 10/16/2007 BY/KAM FH*5.5*12 Rem Call 210883 Remove access to old
- ;                             Clinician field
+ ;;5.5;DIETETICS;**4,5**;Jan 28, 2005;Build 53
 EN2 ; Enter/Edit Nutrition Locations (Inpatient Wards/Outpatient Clinics)
  W ! K DIR,DIC S DIR("A")="Select WARD or OUTPATIENT Location: "
- S DIR(0)="SAO^W:Ward Location;O:Outpatient Location" D ^DIR I $D(DIRUT) G KIL
+ S DIR(0)="SAO^W:Ward Location;O:Outpatient Location" D ^DIR Q:$D(DIRUT)
  I Y'=-1 S FHANS=Y
  I FHANS="W" D EN2WRD Q
@@ -14 +11 @@
  K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQLM",DLAYGO=119.6
  S DIC("DR")=".01" W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN2:Y<1
- ; S DR=".01;2:2.5;... POTENTIAL CHG FOR 210883 WAS S DR=".01:2.5;3"
- ; 10/16/2007 BP/KAM FH*5.5*12 changed next line to remove access to field # 1 Clinician (Old Clinician field)
- S DA=+Y,DR=".01;2:2.5;3;S:X="""" Y=4;3.5;4;S:X="""" Y=5;4.5;5;S:'X Y=6;5.5;6:29;99;107;107.5;108;108.5;109;109.5;110;110.5;111;111.5;112" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.6 D ^DIE,KIL G EN2
+ S DA=+Y,DR=".01:2.5;3;S:X="""" Y=4;3.5;4;S:X="""" Y=5;4.5;5;S:'X Y=6;5.5;6:29;99;107;107.5;108;108.5;109;109.5;110;110.5;111;111.5;112" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=119.6 D ^DIE,KIL G EN2
 EN2OL ;Outpatient locations
  K DIC S (DIC,DIE)="^FH(119.6,",DIC(0)="AEQLM",DLAYGO=119.6

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

@@ -1 +1 @@
 FHPRW ;Hines OIFO/REL,RTK - List Dietetic Locations ;5/13/94  14:57 
- ;;5.5;DIETETICS;**12**;Jan 28, 2005;Build 3
- ; 10/24/07 BAY/KAM FH*5.5*12 CALL 214407 Display new Clinician Field
+ ;;5.5;DIETETICS;;Jan 28, 2005
 F1 R !!,"Select LOCATION (or ALL): ",X:DTIME G:'$T!("^"[X) KIL D:X="all" TR^FH I X="ALL" S WRD=0
  E  K DIC S DIC="^FH(119.6,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 F1 S WRD=+Y
@@ -16 +15 @@
  W !!,"Print Order:",?22,$P(X,"^",4)
  W !,"Type of Location:",?22,$S($P(X,U,3)="O":"OUTPATIENT",1:"INPATIENT")
- ;
- ;10/24/07 BAY/KAM *12 214407 Print new Clinician Multiple field
- N C1 S C1=""
- F  S C1=$O(^FH(119.6,K1,2,C1)) Q:C1=""  D
- .  S Z=$G(^FH(119.6,K1,2,C1,0)) I Z W !,"Assigned Clinician(s):",?22,$P($G(^VA(200,Z,0)),"^",1)
- ;
+ W !,"Assigned Clinician:",?22 S Z=$P(X,"^",2) I Z W $P($G(^VA(200,Z,0)),"^",1)
  W !,"Tray Assembly:",?22 S Z=$P(X,"^",5) I Z W $P($G(^FH(119.72,Z,0)),"^",1) S Z=$P(X,"^",17) S:Z="" Z=100 W "   (",Z,"%)"
  W !,"Cafeteria:",?22 S Z=$P(X,"^",6) I Z W $P($G(^FH(119.72,Z,0)),"^",1) S Z=$P(X,"^",18) S:Z="" Z=100 W "   (",Z,"%)"

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

@@ -1 +1 @@
 FHREP1 ; HISC/NCA - Inventory Worksheet and Report ;3/9/95  08:28
- ;;5.5;DIETETICS;**13**;Jan 28, 2005;Build 1
+ ;;5.5;DIETETICS;;Jan 28, 2005
 EN2 ; Print the Inventory Worksheet & Report
  S FHXX="F"
@@ -10 +10 @@
  K %DT W !!,"Enter Mth/Yr: "_+$E(NOW,4,5)_"/"_$E(NOW,2,3)_"// " R X:DTIME G:'$T!(X["^") KIL^FHREP
  I X="" S X=$E(NOW,1,5)_"00"
- S %DT="M" D ^%DT K %DT I Y<1!($E(Y,1,5)>$E(NOW,1,5)) W *7,"  Answer Month and Yr as Mth/Yr or Mth Yr.",!?25,"   CANNOT be greater than now." G E0
+ D ^%DT I Y<1!($E(Y,1,5)>$E(NOW,1,5)) W *7,"  Answer Month and Yr as Mth/Yr or Mth Yr.",!?25,"   CANNOT be greater than now." G E0
  S MTH=+$E(Y,4,5),MTH=$P("January February March April May June July August September October November December"," ",MTH),YR=$E(Y,2,3),MTH=MTH_" "_YR
  I FHR="W" D F1^FHREP G:FHXX["^"!("^"[X) KIL^FHREP

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

@@ -1 +1 @@
 FHSELA1 ;Hines OIFO/RTK - Map GMR Allergy file to Food Prefs ;3/07/2007
- ;;5.5;DIETETICS;**8,12**;Jan 28, 2005;Build 3
- ;
- ;10/16/2007 BAY/KAM FH*5.5*12 Remedy Call 210385 Do not allow
- ;                             user to change Food Preference name or
- ;                             LIKE/DISLIKE field
+ ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
  ;
 CREATE ; Check for any missing Allergy-type FP's or one's not renamed in 115.2
@@ -42 +38 @@
  S X=FHAFPNM K DIC,DO
  S (DIC,DIE)="^FH(115.2,",DIC(0)="L" D FILE^DICN
- ; 10/16/2007 BP/KAM FH*5.5*12 Default DISLIKE and prevent Food Preference name change in the next line
- S (FHDA,DA)=+Y,DR="26;1////D"
+ S (FHDA,DA)=+Y,DR=".01;26;1//DISLIKE;S:X=""D"" Y=0;3;20;S:'X Y=99;21;99"
  D ^DIE K DA,DIE,DR
  D TRAN^FHSEL1

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

@@ -1 +1 @@
 FHSELA2 ;Hines OIFO/RTK - Map GMR Allergy file to Food Prefs ;3/07/2007
- ;;5.5;DIETETICS;**8,13**;Jan 28, 2005;Build 1
+ ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
  ;
 TMPGL ; Create ^TMP Global
@@ -146 +146 @@
  ;;GREENS, MUSTARD;MUSTARD GREENS
  ;;GREENS, TURNIP;TURNIP GREENS
- ;;GREEN LEAFY VEG;GREEN LEAFY VEGETABLES
+ ;;GREEN LEAFY VEGETABLES;GREEN LEAFY VEGETABLES
  ;;GUAVA;GUAVA
  ;;HOMINY;HOMINY