Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHOMRO1

FHOMRO1.m

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