- FHORO ; HISC/REL - Additional Orders ;2/22/95 10:06 ;
- ;;5.5;DIETETICS;;Jan 28, 2005
- EN1 ; Enter Order
- 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
- ; Set HL7
- D AO^FHWOR1,KIL I $D(MSG) D MSG^XQOR("FH EVSEND OR",.MSG) K MSG
- A0 W " ... done" Q
- R1 ; Process Order
- D LIS
- R2 R !!,"Additional Order: ",COM:DTIME G:'$T!(COM="")!(COM["^") AB I COM'?.ANP W *7," ??" G R2
- I COM?1."?" W *7,!,"Enter your dietetic request. Do not use ^ or ? in your response." G R2
- I $L(COM)>160 W *7,!,"Order not accepted! - Enter 1-160 character order" G R2
- Q:FHWF=2
- 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
- G:YN'?1"Y".E AB Q
- ORD ; Set Order
- L +^FHPT(FHDFN,"A",ADM,"OO",0) S:'$D(^FHPT(FHDFN,"A",ADM,"OO",0)) ^FHPT(FHDFN,"A",ADM,"OO",0)="^115.06^^"
- S FHDR=$P(^FHPT(FHDFN,"A",ADM,"OO",0),"^",3)+1,$P(^(0),"^",3,4)=FHDR_"^"_FHDR L -^FHPT(FHDFN,"A",ADM,"OO",0)
- D NOW^%DTC S NOW=%
- S ^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)=FHDR_"^"_NOW_"^"_COM_"^"_DUZ_"^A"
- S ^FHPT("AOO",FHDFN,ADM,FHDR)="" S EVT="O^O^"_FHDR D ^FHORX Q
- AB W *7,!!,"Order entry is TERMINATED - No request entered!"
- 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
- LIS D NOW^%DTC S X1=%,X2=-1 D C^%DTC S A=X
- S CT=0 W !!,"Additional Orders Last 24 Hours:",!
- 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
- W:'CT !?5,"None Entered." Q
- L1 S DTP=$P(X,"^",2),CT=1 D DTP^FH W !,DTP,?20,$P(X,"^",3) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORO 1647 printed Feb 18, 2025@23:20:12 Page 2
- FHORO ; HISC/REL - Additional Orders ;2/22/95 10:06 ;
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- EN1 ; Enter Order
- +1 SET ALL=0
- DO ^FHDPA
- if 'DFN
- GOTO KIL
- if 'FHDFN
- GOTO KIL
- DO R1
- if '$DATA(DFN)
- GOTO KIL
- if '$DATA(FHDFN)
- GOTO KIL
- DO ORD
- if 'FHWF
- GOTO A0
- +2 ; Set HL7
- +3 DO AO^FHWOR1
- DO KIL
- IF $DATA(MSG)
- DO MSG^XQOR("FH EVSEND OR",.MSG)
- KILL MSG
- A0 WRITE " ... done"
- QUIT
- R1 ; Process Order
- +1 DO LIS
- R2 READ !!,"Additional Order: ",COM:DTIME
- if '$TEST!(COM="")!(COM["^")
- GOTO AB
- IF COM'?.ANP
- WRITE *7," ??"
- GOTO R2
- +1 IF COM?1."?"
- WRITE *7,!,"Enter your dietetic request. Do not use ^ or ? in your response."
- GOTO R2
- +2 IF $LENGTH(COM)>160
- WRITE *7,!,"Order not accepted! - Enter 1-160 character order"
- GOTO R2
- +3 if FHWF=2
- QUIT
- R3 READ !,"Ok to Enter Request? Y// ",YN:DTIME
- if '$TEST!(YN["^")
- GOTO AB
- if YN=""
- SET YN="Y"
- SET X=YN
- DO TR^FH
- SET YN=X
- IF $PIECE("YES",YN,1)'=""
- IF $PIECE("NO",YN,1)'=""
- WRITE *7," Answer YES or NO"
- GOTO R3
- +1 if YN'?1"Y".E
- GOTO AB
- QUIT
- ORD ; Set Order
- +1 LOCK +^FHPT(FHDFN,"A",ADM,"OO",0)
- if '$DATA(^FHPT(FHDFN,"A",ADM,"OO",0))
- SET ^FHPT(FHDFN,"A",ADM,"OO",0)="^115.06^^"
- +2 SET FHDR=$PIECE(^FHPT(FHDFN,"A",ADM,"OO",0),"^",3)+1
- SET $PIECE(^(0),"^",3,4)=FHDR_"^"_FHDR
- LOCK -^FHPT(FHDFN,"A",ADM,"OO",0)
- +3 DO NOW^%DTC
- SET NOW=%
- +4 SET ^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)=FHDR_"^"_NOW_"^"_COM_"^"_DUZ_"^A"
- +5 SET ^FHPT("AOO",FHDFN,ADM,FHDR)=""
- SET EVT="O^O^"_FHDR
- DO ^FHORX
- QUIT
- AB WRITE *7,!!,"Order entry is TERMINATED - No request entered!"
- KIL KILL %,%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
- QUIT
- LIS DO NOW^%DTC
- SET X1=%
- SET X2=-1
- DO C^%DTC
- SET A=X
- +1 SET CT=0
- WRITE !!,"Additional Orders Last 24 Hours:",!
- +2 FOR K=0:0
- SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"OO",K))
- if K<1
- QUIT
- SET X=^(K,0)
- IF $PIECE(X,"^",2)'<A
- IF $PIECE(X,"^",5)'="X"
- DO L1
- +3 if 'CT
- WRITE !?5,"None Entered."
- QUIT
- L1 SET DTP=$PIECE(X,"^",2)
- SET CT=1
- DO DTP^FH
- WRITE !,DTP,?20,$PIECE(X,"^",3)
- QUIT