| 1 | FHORO ; HISC/REL - Additional Orders ;2/22/95  10:06 ;
 | 
|---|
| 2 |  ;;5.5;DIETETICS;;Jan 28, 2005
 | 
|---|
| 3 | EN1 ; Enter Order
 | 
|---|
| 4 |  S ALL=0 D ^FHDPA G:'DFN KIL G:'FHDFN KIL D R1 G:'$D(DFN) KIL G:'$D(FHDFN) KIL D ORD G:'FHWF A0
 | 
|---|
| 5 |  ; Set HL7
 | 
|---|
| 6 |  D AO^FHWOR1,KIL I $D(MSG) D MSG^XQOR("FH EVSEND OR",.MSG) K MSG
 | 
|---|
| 7 | A0 W "  ... done" Q
 | 
|---|
| 8 | R1 ; Process Order
 | 
|---|
| 9 |  D LIS
 | 
|---|
| 10 | R2 R !!,"Additional Order: ",COM:DTIME G:'$T!(COM="")!(COM["^") AB I COM'?.ANP W *7," ??" G R2
 | 
|---|
| 11 |  I COM?1."?" W *7,!,"Enter your dietetic request. Do not use ^ or ? in your response." G R2
 | 
|---|
| 12 |  I $L(COM)>160 W *7,!,"Order not accepted! - Enter 1-160 character order" G R2
 | 
|---|
| 13 |  Q:FHWF=2
 | 
|---|
| 14 | R3 R !,"Ok to Enter Request? Y// ",YN:DTIME G AB:'$T!(YN["^") S:YN="" YN="Y" S X=YN D TR^FH S YN=X I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7," Answer YES or NO" G R3
 | 
|---|
| 15 |  G:YN'?1"Y".E AB Q
 | 
|---|
| 16 | ORD ; Set Order
 | 
|---|
| 17 |  L +^FHPT(FHDFN,"A",ADM,"OO",0) S:'$D(^FHPT(FHDFN,"A",ADM,"OO",0)) ^FHPT(FHDFN,"A",ADM,"OO",0)="^115.06^^"
 | 
|---|
| 18 |  S FHDR=$P(^FHPT(FHDFN,"A",ADM,"OO",0),"^",3)+1,$P(^(0),"^",3,4)=FHDR_"^"_FHDR L -^FHPT(FHDFN,"A",ADM,"OO",0)
 | 
|---|
| 19 |  D NOW^%DTC S NOW=%
 | 
|---|
| 20 |  S ^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)=FHDR_"^"_NOW_"^"_COM_"^"_DUZ_"^A"
 | 
|---|
| 21 |  S ^FHPT("AOO",FHDFN,ADM,FHDR)="" S EVT="O^O^"_FHDR D ^FHORX Q
 | 
|---|
| 22 | AB W *7,!!,"Order entry is TERMINATED - No request entered!"
 | 
|---|
| 23 | KIL K %,%H,%I,%T,A,C,CT,ADM,ALL,COM,DA,FHDFN,DFN,DTP,FHDR,FHPV,FHWF,G,K,I,NOW,POP,WARD,X,X1,X2,Y,YN Q
 | 
|---|
| 24 | LIS D NOW^%DTC S X1=%,X2=-1 D C^%DTC S A=X
 | 
|---|
| 25 |  S CT=0 W !!,"Additional Orders Last 24 Hours:",!
 | 
|---|
| 26 |  F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"OO",K)) Q:K<1  S X=^(K,0) I $P(X,"^",2)'<A,$P(X,"^",5)'="X" D L1
 | 
|---|
| 27 |  W:'CT !?5,"None Entered." Q
 | 
|---|
| 28 | L1 S DTP=$P(X,"^",2),CT=1 D DTP^FH W !,DTP,?20,$P(X,"^",3) Q
 | 
|---|