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 Oct 16, 2024@17:54:40 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
