| [613] | 1 | FHOMRA1 ;Hines OIFO/RTK OUTPATIENT MEALS ADDITIONAL ORDERS ;5/14/03 15:15
|
|---|
| 2 | ;;5.5;DIETETICS;**2**;Jan 28, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | S FHMSG1="A" D GETOPT^FHOMUTL I FHFIND=0 Q
|
|---|
| 5 | K NUM D DISP^FHOMRR1 I $G(NUM)="" Q
|
|---|
| 6 | AO1 W ! K DIR S DIR("A")="Select Order(s)",DIR(0)="LO^1:"_NUM D ^DIR
|
|---|
| 7 | Q:$D(DIRUT) S FHCLST=Y
|
|---|
| 8 | S FHCAN1=0 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=FHLIST(FHC) I $P($G(^FHPT(FHDFN,"OP",+FHRNUM,0)),U,15)'="C" S FHCAN1=1
|
|---|
| 9 | I FHCAN1=0 W !!?3,"The selected order(s) have been cancelled!",! D AO1 Q
|
|---|
| 10 | W ! K DIR S DIR("A")="Additional Order: ",DIR(0)="FAO^1:160" D ^DIR
|
|---|
| 11 | I $D(DIRUT) D EXMSG^FHOMUTL Q
|
|---|
| 12 | S FHTEXT=Y
|
|---|
| 13 | W ! K DIR S DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="Y"
|
|---|
| 14 | D ^DIR I $D(DIRUT)!(Y=0) D EXMSG^FHOMUTL,END Q
|
|---|
| 15 | W !
|
|---|
| 16 | F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHRNUM=FHLIST(FHC) D CHK
|
|---|
| 17 | D OKMSG^FHOMUTL
|
|---|
| 18 | D END Q
|
|---|
| 19 | CHK ;
|
|---|
| 20 | I $P($G(^FHPT(FHDFN,"OP",+FHRNUM,0)),U,15)="C" S FHDTX=$P(FHRNUM,U,2),FHDTX=$$FMTE^XLFDT(FHDTX,"P") W !?3,"The order for ",$E(FHDTX,1,12)," has been cancelled -- not ordered!" Q
|
|---|
| 21 | D SET,UPD100
|
|---|
| 22 | Q
|
|---|
| 23 | SET ;
|
|---|
| 24 | D NOW^%DTC S FHTODAY=$E(%,1,12)
|
|---|
| 25 | S FHORN=$S($G(FHORN)="":"",1:FHORN)
|
|---|
| 26 | K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"",",DA=+FHRNUM
|
|---|
| 27 | S DR="11////^S X=FHTEXT;12////^S X=DUZ;13////^S X=FHTODAY;13.5////^S X=FHORN" D ^DIE
|
|---|
| 28 | S FHACT="O",FHOPTY="A",FHAET=FHTEXT D SETAET^FHOMRO2
|
|---|
| 29 | Q
|
|---|
| 30 | END ;
|
|---|
| 31 | K A,FHFIND,FHCLST,FHC,FHRNUM,FHTEXT,FHTODAY,NUM Q
|
|---|
| 32 | HL7SET ;
|
|---|
| 33 | ; Entry point for AO's placed from CPRS/OERR
|
|---|
| 34 | S FHTEXT=FHCOM,X1=STDT,X2=-1 D C^%DTC S STDT1=X
|
|---|
| 35 | F FHRMDT=STDT1:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0!(FHRMDT>ENDT) F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 D SET
|
|---|
| 36 | I '$D(FHRNUM) Q
|
|---|
| 37 | S FILL="A;"_FHRNUM_";"_FHCOM_";"_FHORN
|
|---|
| 38 | D SEND^FHWOR Q
|
|---|
| 39 | UPD100 ;Backdoor message to update file #100 with a new AO order
|
|---|
| 40 | Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
|---|
| 41 | Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
|---|
| 42 | S FILL="A;"_FHRNUM,FHODT=$P(FHRNUM,U,2),FHODT=$$FMTHL7^XLFDT(FHODT)
|
|---|
| 43 | S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHTODAY
|
|---|
| 44 | S MSG(5)="ODS|D||^^^FH-6^Additional Order^99OTH|"_FHTEXT
|
|---|
| 45 | D EVSEND^FHWOR
|
|---|
| 46 | Q
|
|---|
