1 | FHOMSR1 ;Hines OIFO/RTK SPECIAL MEALS REQUEST MEAL ;4/02/03 15:05
|
---|
2 | ;;5.5;DIETETICS;**2,5,11**;Jan 28, 2005;Build 4
|
---|
3 | ;
|
---|
4 | S (FHORN,FHDIET)="",FHKEY=0,FHMSG1="S"
|
---|
5 | D ^FHOMDPA I FHDFN="" Q
|
---|
6 | I '$D(^FHPT(FHDFN,0)) W !!,"UNKNOWN SELECTION !" Q
|
---|
7 | D SMSTAT^FHOMUTL I FHSTAT="P" D MSG1 Q
|
---|
8 | I $D(^XUSEC("FHAUTH",DUZ)) S FHKEY=1
|
---|
9 | LOC ;Prompt for outpatient location
|
---|
10 | W ! D OUTLOC^FHOMUTL I FHLOC="" D EXMSG^FHOMUTL Q
|
---|
11 | W ! D RMBED^FHOMUTL
|
---|
12 | DIET ;Prompt for diet
|
---|
13 | D DIETLST^FHOMUTL
|
---|
14 | I FHDEF="" W !!,"NO DEFAULT OUTPATIENT DIET SET!!",! Q
|
---|
15 | S FHDEF=$P($G(^FH(111,FHDEF,0)),U,1)
|
---|
16 | K DIC S DIC="^FH(111,",DIC("A")="Select DIET NAME: ",DIC(0)="AEMQZ"
|
---|
17 | S DIC("B")=FHDEF,DIC("S")="I $D(FHDIETS(+Y))" D ^DIC
|
---|
18 | I $D(DUOUT) D EXMSG^FHOMUTL Q
|
---|
19 | I Y=-1 D EXMSG^FHOMUTL Q
|
---|
20 | S FHDIET=+Y
|
---|
21 | MEAL ;Prompt for meal
|
---|
22 | K DIR,DIC S DIR("A")="Select Meal: "
|
---|
23 | S DIR(0)="SAO^B:Breakfast;N:Noon;E:Evening"
|
---|
24 | D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
|
---|
25 | I Y'=-1 S FHMEAL=Y
|
---|
26 | D CHECKRM I FHRMYES=1 D MSG2 Q
|
---|
27 | W ! K DIR S DIR("A")="Is this correct?: ",DIR(0)="YA",DIR("B")="Y"
|
---|
28 | D ^DIR
|
---|
29 | S CONT=Y I CONT'=1 D EXMSG^FHOMUTL Q
|
---|
30 | D NOW^%DTC S FHNOW=%,STDT=DT,FHLTFLG=0 D SMGM^FHOMRO2
|
---|
31 | I SKIP=1 D EXMSG^FHOMUTL Q
|
---|
32 | S FHQEL=1 I FHLTFLG=1 S FHSM=FHNOW,FHEL="L",FHQEL=0 D LATE I FHQEL=1 D EXMSG^FHOMUTL Q
|
---|
33 | S FHSTAT=$S(FHKEY=1:"A",1:"P") D SETNODE,UPD100
|
---|
34 | I FHQEL=0 D UPDE100
|
---|
35 | D OKMSG^FHOMUTL
|
---|
36 | I FHKEY=1 D PRINT
|
---|
37 | I FHKEY=0 D ALERT
|
---|
38 | D END Q
|
---|
39 | PRINT ;If user has key allow printing without sending alert to authorizor(s)
|
---|
40 | W ! S DIR(0)="YA",DIR("B")="Y",DIR("A")="Print Voucher? " D ^DIR
|
---|
41 | Q:$D(DIRUT) S PRINT=Y I PRINT'=1 Q
|
---|
42 | S FHCDT=FHDFN_"^"_FHNOW,FHREQPR=1 D DEV^FHOMSP1 K FHREQPR Q
|
---|
43 | ALERT ;Send alert to 15 Authorizors set up in file #119.9 (fields 9-13,40-49)
|
---|
44 | K XQA,FHAU15 S FHAU15=$P($G(^FH(119.9,1,0)),U,7,11)_"^"_$P($G(^FH(119.9,1,1)),U,11,20)
|
---|
45 | F A=1:1:15 S AB=$P(FHAU15,U,A) I AB'="" S XQA(AB)=""
|
---|
46 | I '$D(XQA) D
|
---|
47 | .W !!?5,"NOTICE: No 'Authorizing Person(s)' defined in site "
|
---|
48 | .W !!?5,"parameter (#119.9) file -- NO ALERT SENT",!! Q
|
---|
49 | D PATNAME^FHOMUTL
|
---|
50 | S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
|
---|
51 | S XQAMSG=XQAMSG_"Special Meal needs authorizing" D SETUP^XQALERT
|
---|
52 | Q
|
---|
53 | SETNODE ;
|
---|
54 | S AUDUZ=$S(FHSTAT="A":DUZ,1:""),AUFHNOW=$S(FHSTAT="A":FHNOW,1:"")
|
---|
55 | S (FHSMID,Y)=FHNOW K DIC,DO S DA(1)=FHDFN,DIC="^FHPT("_DA(1)_",""SM"","
|
---|
56 | S DIC(0)="L",DIC("P")=$P(^DD(115,17,0),U,2),X=+Y,DINUM=X
|
---|
57 | D FILE^DICN I Y=-1 Q
|
---|
58 | K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
|
---|
59 | S DA=+Y,FHDA=DA
|
---|
60 | S DR="1////^S X=FHSTAT;2////^S X=FHLOC;2.5////^S X=FHRMBD;3////^S X=FHDIET;3.5////^S X=FHMEAL;4////^S X=DUZ;5////^S X=AUDUZ;6////^S X=AUFHNOW;14////^S X=FHORN"
|
---|
61 | D ^DIE
|
---|
62 | I FHQEL=0 D ORDEL
|
---|
63 | S FHZN=$G(^FHPT(FHDFN,"SM",FHDA,0))
|
---|
64 | S FHACT="O",FHOPTY="S",FHOPDT=$P(FHNOW,".",1) D SETSM^FHOMRO2
|
---|
65 | Q
|
---|
66 | MSG1 ;
|
---|
67 | W !!,"This patient already has a pending Special Meal request for "
|
---|
68 | S DTP=DT D DTP^FH W DTP," " Q
|
---|
69 | MSG2 ;
|
---|
70 | W !!,"This patient already has a Recurring Meal ordered for "
|
---|
71 | S DTP=DT D DTP^FH W DTP," "
|
---|
72 | W $S(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening") Q
|
---|
73 | CHECKRM ; Check if the OP has an existing RM for this date/meal
|
---|
74 | S FHRMYES=0
|
---|
75 | F FHZ=0:0 S FHZ=$O(^FHPT(FHDFN,"OP","B",DT,FHZ)) Q:FHZ'>0!(FHZ>DT) D
|
---|
76 | .I $P($G(^FHPT(FHDFN,"OP",FHZ,0)),U,4)'=FHMEAL Q
|
---|
77 | .I $P($G(^FHPT(FHDFN,"OP",FHZ,0)),U,15)="C" Q
|
---|
78 | .S FHRMYES=1
|
---|
79 | Q
|
---|
80 | END ;Kill local variables before exiting
|
---|
81 | K A,AA,AB,BAG,CCC,CONT,DIC,DIR,ENDL,ENDT,FHDFN,FHDAYS,FHDEF
|
---|
82 | K FHDIET,FHDIETS,FHSTAT,FHZ,STDT,STDTIM Q
|
---|
83 | ;
|
---|
84 | LATE ;
|
---|
85 | S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8),FHCOMM1=$G(^FH(119.73,FHCOMM,1))
|
---|
86 | S FH1=$S(FHMEAL="B":1,FHMEAL="N":7,1:13) I FHEL="L" S FH1=FH1+3
|
---|
87 | TIME S FH3=FH1+2,FHCNT=0 F FHT=FH1:1:FH3 D
|
---|
88 | .I $P(FHCOMM1,U,FHT)="" Q
|
---|
89 | .S FHCNT=FHCNT+1,FHTM(FHCNT)=$P(FHCOMM1,U,FHT)
|
---|
90 | W !,"Select Time: ( " F J=1:1:FHCNT W J,"=",FHTM(J)," "
|
---|
91 | R ") ",FHS:DTIME I FHS=""!(FHS["^") S FHQEL=1 Q
|
---|
92 | I (FHS'?1N)!(FHS<1)!(FHS>FHCNT) W !!,"Invalid time selection!" D TIME Q
|
---|
93 | S FHTIME=FHTM(FHS),X=$E(FHNOW,1,7)_"@"_FHTIME,%DT="XT" D ^%DT S FHTRAY=Y
|
---|
94 | D NOW^%DTC I FHTRAY<% W !!,"Cannot order for a time before now!" D TIME Q
|
---|
95 | S FHBAG="N" I $P($G(^FH(119.73,FHCOMM,2)),U,10)="Y" D
|
---|
96 | . K DIR S DIR(0)="SAO^Y:Yes;N:No",DIR("A")="Bagged Meal? ",DIR("B")="N"
|
---|
97 | . D ^DIR I $D(DIRUT) S FHQEL=1 Q
|
---|
98 | . S FHBAG=Y
|
---|
99 | Q
|
---|
100 | ORDEL ;
|
---|
101 | S DA=FHSM,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
|
---|
102 | S DR="8////^S X=FHTIME;9////^S X=FHBAG;10////^S X=DUZ" D ^DIE
|
---|
103 | Q
|
---|
104 | UPD100 ;Backdoor message to update file #100 with a new SM order
|
---|
105 | Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
---|
106 | Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
---|
107 | S FILL="S;"_FHNOW
|
---|
108 | S FHOMEAL=$S(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
|
---|
109 | S FHDIETNM=$P($G(^FH(111,FHDIET,0)),U,1),FHODT=$$FMTHL7^XLFDT(FHNOW)
|
---|
110 | S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHODT
|
---|
111 | S MSG(5)="ODS|S|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHDIETNM_"^99FHD|"
|
---|
112 | D EVSEND^FHWOR
|
---|
113 | Q
|
---|
114 | UPDE100 ;Backdoor message to update file #100 with a new SM Late Tray order
|
---|
115 | Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
---|
116 | Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
---|
117 | S FILL="G;"_FHNOW,FHODT=$$FMTHL7^XLFDT(FHNOW)
|
---|
118 | S FHTRAY=$$FMTHL7^XLFDT(FHTRAY)
|
---|
119 | S FHOMELN=FHMEAL_"L"_FHS,FHOBAG="" I FHBAG="Y" S FHOBAG="bagged"
|
---|
120 | S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHTRAY_"^"_FHTRAY_"||||||||"_FHODT
|
---|
121 | S MSG(5)="ODT|LATE|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
|
---|
122 | D EVSEND^FHWOR
|
---|
123 | Q
|
---|