| 1 | FHORD ; HISC/REL/NCA - Diet Order Entry ;8/9/96  12:29 ;
 | 
|---|
| 2 |  ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
 | 
|---|
| 3 | EN1 ; Edit Diets
 | 
|---|
| 4 |  S CHK=0,TYP="D",EVENT="UPD",REC=1,(NOD1,NOD2)="" K ^TMP($J,"FHNOD3")
 | 
|---|
| 5 |  S (DIC,DIE)="^FH(111,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=111 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN1:Y<1
 | 
|---|
| 6 |  S FHOLDLB=$P($G(^FH(111,+Y,0)),U,7)
 | 
|---|
| 7 |  S IEN=Y,NOD1=$P($G(^FH(111,+IEN,0)),"^",1,4),NOD2=$G(^FH(111,+IEN,"I"))
 | 
|---|
| 8 |  F IEN1=0:0 S IEN1=$O(^FH(111,+IEN,"AN",IEN1)) Q:IEN1<1  S:'$D(^TMP($J,"FHNOD3",IEN1)) ^TMP($J,"FHNOD3",IEN1)=$G(^FH(111,+IEN,"AN",IEN1,0))
 | 
|---|
| 9 |  ;DR STRING MODIFIED TO ONLY EDIT INACTIVE STATUS IF DIET ORDER INACTIVE
 | 
|---|
| 10 |  S DA=+Y,DR="I $G(^FH(111,+IEN,""I""))=""Y"" S Y=99;"_$S(DA'=1:".01:99",1:"1;2;5;6;10"),DIE("NO^")="" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=111 D ^DIE K DIC,DIE,DIDEL I $D(^ORD(101.43)) D UPDATE^FHWOR6
 | 
|---|
| 11 |  S FHNEWLB=$P($G(^FH(111,+IEN,0)),U,7)
 | 
|---|
| 12 |  I FHOLDLB'=FHNEWLB,FHOLDLB'="" W !!,"The Abbreviated Label for this Diet has been changed to ",$P($G(^FH(111,+IEN,0)),U,7),".",!,"Diet Patterns containing this Diet will now be updated to reflect this change:",! H 2 D UPDPAT
 | 
|---|
| 13 |  G EN1
 | 
|---|
| 14 | EN2 ; List Diets
 | 
|---|
| 15 |  W !!,"The list requires a 132 column printer.",!
 | 
|---|
| 16 |  W ! S L=0,DIC="^FH(111,",FLDS="[FHDIETL]",BY="NAME"
 | 
|---|
| 17 |  S FR="",TO="",DHD="DIETS LIST" D EN1^DIP,RSET Q
 | 
|---|
| 18 | KIL K ^TMP($J),%,ADM,ALL,C,CHK,D,DA,DIC,DIE,DR,FHDFN,DFN,EVENT,FHDR,FHK,I,IEN,IEN1,FHNEWLB,FHNEWNM,FHOLDLB,FHOLDNM,FHFH,FHFND,FHDPIEN,FLG,FHX1,FHX2,FHWF,FHPV,COM,NOD1,NOD2,NOD3,NOW,POP,REC,STR,STR1,TYP,WARD,X Q
 | 
|---|
| 19 | RSET K %ZIS S IOP="" D ^%ZIS K %ZIS,IOP,BY,DA,FHDFN,DFN,DHD,DIC,DIE,DR,FLDS,FR,L,TO,X,Y Q
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 | UPDPAT ; Update Diet Pattern names
 | 
|---|
| 22 |  S FLG=0 F FHDPIEN=0:0 S FHDPIEN=$O(^FH(111.1,FHDPIEN)) Q:FHDPIEN'>0  D
 | 
|---|
| 23 |  .S FHFND=0,FHOLDNM=$P($G(^FH(111.1,FHDPIEN,0)),U,1)
 | 
|---|
| 24 |  .S FHDPDTS=$P($G(^FH(111.1,FHDPIEN,0)),U,2,6)
 | 
|---|
| 25 |  .F FHFH=1:1:5 I $P(FHDPDTS,U,FHFH)=+IEN S FHFND=FHFH
 | 
|---|
| 26 |  .Q:FHFND=0
 | 
|---|
| 27 |  .S FLG=1,FHNEWNM=FHOLDNM S $P(FHNEWNM,",",FHFND)=" "_FHNEWLB
 | 
|---|
| 28 |  .I $E(FHNEWNM,1)=" " S FHNEWNM=$E(FHNEWNM,2,99)
 | 
|---|
| 29 |  .W !,FHOLDNM," will change to ",FHNEWNM
 | 
|---|
| 30 |  .K DIE S DIE="^FH(111.1,",DA=FHDPIEN,DR=".01////^S X=FHNEWNM" D ^DIE
 | 
|---|
| 31 |  W !!,$S(FLG=1:"...Diet Patterns have been updated!",1:"...No Diet Patterns needed updating.") Q
 | 
|---|