202 lines
8.9 KiB
Mathematica
202 lines
8.9 KiB
Mathematica
FHOMRO1 ;Hines OIFO/RTK RECURRING MEALS ORDER EDIT ;2/04/03 14:05
|
|
;;5.5;DIETETICS;**1,2,5**;Jan 28, 2005;Build 53
|
|
;
|
|
S FHDIET="" F FHDX=1:1:5 S FHDIETX(FHDX)=""
|
|
S FHMSG1="R" D ^FHOMDPA I FHDFN="" Q
|
|
I '$D(^FHPT(FHDFN,0)) W !!,"UNKNOWN SELECTION !" Q
|
|
D NOW^%DTC S X1=$E(%,1,7),X2=-1 D C^%DTC S FHNOW=X D CHECK
|
|
I FHEXST=1 D ORDEDT,END Q
|
|
D ORDER,END Q
|
|
ORDEDT ;
|
|
W !!,"This person has an existing outpatient diet order."
|
|
K DIR S DIR(0)="SBO^E:Edit;O:New Order"
|
|
S DIR("A")="Edit the existing diet or order another one" D ^DIR
|
|
Q:$D(DIRUT)
|
|
I Y="O" D ORDER Q
|
|
I Y="E" D EDIT Q
|
|
Q
|
|
ORDER ;
|
|
W ! D OUTLOC^FHOMUTL I FHLOC="" D EXMSG^FHOMUTL Q
|
|
W ! D RMBED^FHOMUTL
|
|
DIETORD ;
|
|
I $P($G(^FH(119.6,FHLOC,1)),U,4)="Y" D MULTDT D:FHDIETX(1)="" EXMSG^FHOMUTL Q:FHDIETX(1)="" D DATE Q
|
|
D DIETLST^FHOMUTL I FHDEF="" W !!,"NO DEFAULT OUTPATIENT DIET SET!!",! Q
|
|
S FHDEF=$P($G(^FH(111,FHDEF,0)),U,1)
|
|
K DIC S DIC="^FH(111,",DIC("A")="Select DIET NAME: ",DIC(0)="AEMQZ"
|
|
S DIC("B")=FHDEF,DIC("S")="I $D(FHDIETS(+Y))" D ^DIC
|
|
I $D(DUOUT) D EXMSG^FHOMUTL Q
|
|
I Y=-1 D EXMSG^FHOMUTL Q
|
|
S FHDIET=+Y
|
|
DATE ;
|
|
K DIR S DIR("A")="Select Start Date: ",DIR(0)="DAO^DT" D ^DIR
|
|
I $D(DIRUT) D EXMSG^FHOMUTL Q
|
|
S (FHOSTDT,STDT)=Y S Y=STDT D DD^%DT W " ",Y
|
|
S FHMAX=$P($G(^FH(119.6,FHLOC,1)),U,2) I FHMAX="" S FHMAX=999
|
|
D NOW^%DTC S FHTODAY=$E(%,1,7),X1=FHTODAY,X2=FHMAX D C^%DTC S FHCUT=X
|
|
K DIR S DIR("A")="Select End Date: ",DIR(0)="DAO^"_STDT_":"_FHCUT D ^DIR
|
|
I $D(DIRUT) D EXMSG^FHOMUTL Q
|
|
S ENDT=Y S Y=ENDT D DD^%DT W " ",Y
|
|
DAYS ;
|
|
S FHIFLG=0 D SHDAYS
|
|
K DIR S DIR("A")="Select Days of Week: ",DIR(0)="FAO"
|
|
D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
|
|
S FHDAYS=Y D DAYCHK I FHIFLG=1 D DAYS Q
|
|
K DIR S DIR("A")="Select MEAL: "
|
|
S DIR(0)="SAO^B:Breakfast;N:Noon;E:Evening"
|
|
D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
|
|
S FHMEAL=Y W !
|
|
I STDT=DT S X=DT D H^%DTC I FHDAYS[$E("XMTWRFS",%Y+1) D CHECKSM I FHSMYES=1 D MSG1 S X1=STDT,X2=1 D C^%DTC S STDT=X I X>ENDT Q
|
|
K DIR S DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="Y" D ^DIR
|
|
S CONT=Y I CONT'=1 D EXMSG^FHOMUTL Q
|
|
S STDTMP=STDT,FHTDTMP=FHTODAY I STDT=DT D CHK1^FHOMRO2
|
|
D SETNODE,UPD100
|
|
I FHSETFLG=0 W !!!?5,"No meals ordered!",! Q
|
|
S FHMSG1="R" D OKMSG^FHOMUTL
|
|
S FHLTFLG=0 I STDTMP=FHTDTMP D CHK2^FHOMRO2
|
|
I FHLTFLG=1 F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHTODAY,FHRNUM)) Q:FHRNUM'>0 D
|
|
.I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)'=FHMEAL Q
|
|
.I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
|
|
.S FHEL="L",FHRMDT=FHTODAY D ORD^FHOMRE1
|
|
Q
|
|
SETNODE ;
|
|
S FHMPNUM=$O(^FHPT(FHDFN,"OP","C",""),-1),FHADSFF=0 I FHMPNUM="" S FHMPNUM=0
|
|
S FHMPNUM=FHMPNUM+1,FHSETFLG=0
|
|
K ODAYS S CCC=0,X1=STDT,X2=-1 D C^%DTC S STDT=X
|
|
S ENDL=0 F Q:ENDL=1 D
|
|
.S CCC=CCC+1,X1=STDT,X2=1 D C^%DTC S STDT=X
|
|
.I STDT>ENDT S ENDL=1 Q
|
|
.S X=STDT D DOW^%DTC
|
|
.I FHDAYS[$E("XMTWRFS",Y+1) S ODAYS(STDT)=STDT D SET
|
|
.Q
|
|
S FHACT="O",FHOPTY="R" D SETORX^FHOMRO2 ;creates RM events
|
|
I $G(FHDPATT)="",FHDIET'="@" S FHDPATT=FHDIET_"^^^^"
|
|
D SOSFFP^FHOMRO2 ;created diet related SO's, SF's, FP's
|
|
D SOEVNT^FHSPED ;creates so events
|
|
D SFEVNT^FHNO7 ;creates sf events
|
|
Q
|
|
SET ;
|
|
S FHPREVML=0 D PREV I FHPREVML=1 Q
|
|
S FHSETFLG=1
|
|
;I $O(^FHPT(FHDFN,"OP","B",STDT,FHRNUM)) Q:FHRNUM'>0 D
|
|
D CPRSO^FHSPED ;check previous SO
|
|
D CPRSF^FHNO7 ;check previous SF
|
|
S Y=STDT K DIC,DO S DA(1)=FHDFN,DIC="^FHPT("_DA(1)_",""OP"","
|
|
S DIC(0)="L" ;,DIC("P")=$P(^DD(115,16,0),U,2),X=+Y,DINUM=X
|
|
D FILE^DICN I Y=-1 Q
|
|
K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
|
|
S FHORN=$S($G(FHORN)="":"",1:FHORN),DA=+Y
|
|
S DR="1////^S X=FHDIET;2////^S X=FHLOC;2.5////^S X=FHRMBD;3////^S X=FHMEAL;5////^S X=FHMPNUM;6////^S X=FHDIETX(1);7////^S X=FHDIETX(2);8////^S X=FHDIETX(3);9////^S X=FHDIETX(4);10////^S X=FHDIETX(5);.05////^S X=FHORN;24.5////^S X=DUZ" D ^DIE
|
|
S ADM=DA
|
|
D PPRSO^FHSPED ;process previous SO automatically to the new Recurring meal entry.
|
|
D PPRSF^FHNO7 ;process previous SF automatically.
|
|
Q
|
|
MULTDT ;
|
|
S FHDPATT="",FHDIET="@" F FHDX=1:1:5 S FHDIETX(FHDX)="@"
|
|
D ^FHOMRO3 I $O(FHDI(0))="" F FHDX=1:1:5 S FHDIETX(FHDX)="" Q
|
|
S FHDX=0 F FHD0=0:0 S FHD0=$O(FHDI(FHD0)) Q:FHD0="" S FHDX=FHDX+1,FHDIETX(FHDX)=$P(FHDI(FHD0),"^",1),FHDPATT=FHDPATT_FHDIETX(FHDX)_"^"
|
|
Q
|
|
SHDAYS ;
|
|
W !!," Mon Tues Wed Thur Fri Sat Sun"
|
|
W !," M T W R F S X"
|
|
W !!,"Enter string of characters for desired days of week: e.g., MWF",!
|
|
Q
|
|
DAYCHK ;
|
|
S X=FHDAYS D TR^FH S FHDAYS=X
|
|
S X1="" F K=1:1 S Z=$E(FHDAYS,K) Q:Z=""!(FHIFLG=1) D
|
|
.I X1[Z S FHIFLG=1 Q
|
|
.I "MTWRFSX"'[Z S FHIFLG=1 Q
|
|
.S X1=X1_Z Q
|
|
I FHIFLG=1 W !!,"Please enter the desired days of the week.",!
|
|
Q
|
|
PREV ;
|
|
F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",STDT,FHRNUM)) Q:FHRNUM'>0!(FHPREVML=1) D
|
|
.I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)'=FHMEAL Q
|
|
.I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
|
|
.D PATNAME^FHOMUTL S FHPREDT=$$FMTE^XLFDT(STDT,"P") I $G(FHHL7)'=1 D
|
|
..W !!?3,FHPTNM," ALREADY HAS A "
|
|
..W $S(FHMEAL="B":"BREAKFAST",FHMEAL="N":"NOON",1:"EVENING")
|
|
..W " MEAL ORDERED FOR ",FHPREDT
|
|
.S FHPREVML=1
|
|
Q
|
|
CHECK ;
|
|
S FHEXST=0 I $O(^FHPT(FHDFN,"OP","B",FHNOW)) D
|
|
.F FHRMDT=FHNOW:0 S FHRMDT=$O(^FHPT(FHDFN,"OP","B",FHRMDT)) Q:FHRMDT'>0 F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRMDT,FHRNUM)) Q:FHRNUM'>0 I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)'="C" S FHEXST=1
|
|
Q
|
|
CHECKSM ; Check if the OP has an existing SM for this date/meal
|
|
S FHSMYES=0
|
|
F FHZ=DT:0 S FHZ=$O(^FHPT(FHDFN,"SM","B",FHZ)) Q:FHZ'>0 D
|
|
.I $P($G(^FHPT(FHDFN,"SM",FHZ,0)),U,9)'=FHMEAL Q
|
|
.I $P($G(^FHPT(FHDFN,"SM",FHZ,0)),U,2)="C" Q
|
|
.I $P($G(^FHPT(FHDFN,"SM",FHZ,0)),U,2)="D" Q
|
|
.S FHSMYES=1
|
|
Q
|
|
MSG1 ;
|
|
W !!,"This patient already has a Special Meal ordered for "
|
|
S DTP=DT D DTP^FH W DTP," "
|
|
W $S(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening"),! H 1 Q
|
|
;
|
|
END ;Kill local variables before exiting
|
|
D KILL^FHOMRO2
|
|
Q
|
|
;
|
|
EDIT ;
|
|
D NOW^%DTC S STDT=$E(%,1,7),FHDTRLE=%
|
|
D DISP^FHOMRR1
|
|
EDT1 K DIR S DIR(0)="NAO^1:"_NUM,DIR("A")="Edit Which Order? " D ^DIR
|
|
Q:$D(DIRUT)
|
|
S ORDNUM=Y,Y=$P(FHLIST(ORDNUM),U,2) D DD^%DT W !,Y,!
|
|
S DA=$P(FHLIST(ORDNUM),U,1),DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""OP"","
|
|
I $P($G(^FHPT(FHDFN,"OP",DA,0)),U,15)="C" W !!?3,"The selected order has been cancelled!",! D EDT1 Q
|
|
S FHLPT=$P($G(^FHPT(FHDFN,"OP",DA,0)),U,3),FHMEAL=$P($G(^FHPT(FHDFN,"OP",DA,0)),U,4)
|
|
D OUTLOC I FHLOC="" D UPXMSG^FHOMUTL Q
|
|
I $P($G(^FH(119.6,FHLOC,1)),U,4)="Y" D MULTDT D:FHDIETX(1)="" UPXMSG^FHOMUTL Q:FHDIETX(1)="" S FHDIET="@" D SETEDT Q
|
|
D DIETLST^FHOMUTL I FHDEF="" W !!,"NO DEFAULT OUTPATIENT DIET SET!!",! Q
|
|
S FHDEF2=$P($G(^FHPT(FHDFN,"OP",DA,0)),U,2) I FHDEF2'="" S FHDEF=$P($G(^FH(111,FHDEF2,0)),U,1)
|
|
K DIC S DIC="^FH(111,",DIC("A")="Select DIET NAME: ",DIC(0)="AEMQZ"
|
|
S DIC("B")=FHDEF,DIC("S")="I FHSPDTS[$P(^(0),U)" D ^DIC
|
|
I $D(DUOUT) D UPXMSG^FHOMUTL Q
|
|
I Y=-1 D UPXMSG^FHOMUTL Q
|
|
S FHDIET=+Y F FHDX=1:1:5 S FHDIETX(FHDX)="@"
|
|
SETEDT ;
|
|
W ! S FHZDA=DA,DR="2////^S X=FHLOC;1////^S X=FHDIET;6////^S X=FHDIETX(1);7////^S X=FHDIETX(2);8////^S X=FHDIETX(3);9////^S X=FHDIETX(4);10////^S X=FHDIETX(5);25////^S X=FHDTRLE;24.5////^S X=DUZ"
|
|
D ^DIE,UPDMSG^FHOMUTL,ED100
|
|
Q
|
|
OUTLOC ;Prompt for outpatient location - screen for ONLY Outpatient Locations
|
|
S FHLOC="",FHOUT="O"
|
|
K DIC S DIC="^FH(119.6,",DIC(0)="AEQZ",DIC("B")=FHLPT
|
|
S DIC("A")="Select OUTPATIENT LOCATION: "
|
|
S DIC("S")="I $P(^(0),U,3)=FHOUT" D ^DIC
|
|
Q:$D(DUOUT) I Y=-1 Q
|
|
S FHLOC=+Y I '$D(^FH(119.6,FHLOC,"L")) S FHLOC="" W !!,"The selected location does not have an Associated Hospital Location."
|
|
Q
|
|
UPD100 ;Backdoor message to update file #100 with a new RM order
|
|
Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
|
Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
|
K N1 S FHODAYS=""
|
|
F N=1:1:7 S FH1=$E(FHDAYS,N) Q:FH1="" S M=$F("MTWRFSX",FH1)-1,N1(M)=""
|
|
F N=0:0 S N=$O(N1(N)) Q:N'>0 S FHODAYS=FHODAYS_"~QJ"_N
|
|
S FHODAYS=$E(FHODAYS,2,999)
|
|
S FHOMEAL=$S(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
|
|
I FHDIET'="@" S FHODNM=$P($G(^FH(111,FHDIET,0)),U,1)
|
|
S FHOSTDT=$$FMTHL7^XLFDT(FHOSTDT),FHOENDT=$$FMTHL7^XLFDT(ENDT)
|
|
S FHOTDAY=$$FMTHL7^XLFDT(FHTODAY)
|
|
S FILL="R;"_FHMPNUM_";"_FHOSTDT_";"_ENDT_";"_FHDAYS_";"_FHMEAL
|
|
S MSG(4)="ORC|SN||"_FILL_"^FH||||^"_FHODAYS_"^^"_FHOSTDT_"^"_FHOENDT_"||||||||"_FHOTDAY
|
|
I FHDIET'="@" S MSG(5)="ODS|D|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHODNM_"^99FHD|"
|
|
I FHDIET="@" D
|
|
.F N=0:0 S N=$O(FHDIETX(N)) Q:N'>0 Q:FHDIETX(N)="" S FHODNM=$P($G(^FH(111,FHDIETX(N),0)),U,1),MSG(N+4)="ODS|D|"_FHOMEAL_"|^^^"_FHDIETX(N)_"^"_FHODNM_"^99FHD|"
|
|
D EVSEND^FHWOR
|
|
Q
|
|
ED100 ;Backdoor message to update file #100 with an edited RM order
|
|
Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
|
Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
|
S (FHOSTDT,FHOENDT)=$P($G(^FHPT(FHDFN,"OP",FHZDA,0)),U,1)
|
|
S FHOSTDT=$$FMTHL7^XLFDT(FHOSTDT),FHOENDT=$$FMTHL7^XLFDT(FHOENDT)
|
|
S FILL="RMEDIT;"_FHZDA,FHORN=$P($G(^FHPT(FHDFN,"OP",FHZDA,0)),U,12)
|
|
S FHODNM=$P($G(^FH(111,FHDIET,0)),U,1)
|
|
S FHOMEAL=$S(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
|
|
S MSG(4)="ORC|XX|"_FHORN_"^OR|"_FILL_"^FH||||^^^"_FHOSTDT_"^"_FHOENDT_"||||||||"
|
|
S MSG(5)="ODS|D|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHODNM_"^99FHD|"
|
|
D EVSEND^FHWOR
|
|
Q
|