| 1 | FHOMSA1 ;Hines OIFO/RTK SPECIAL MEALS AUTHORIZE MEAL  ;4/11/03  12:55
 | 
|---|
| 2 |  ;;5.5;DIETETICS;**2**;Jan 28, 2005
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  I '$D(^XUSEC("FHAUTH",DUZ)) W !!!,"To access this option you most hold the 'FHAUTH' key!",!! H 3 Q
 | 
|---|
| 5 |  S STDT=DT,FHS="P" D LIST^FHOMSS1 W !
 | 
|---|
| 6 |  I NUM=0 W !,"NO PENDING SPECIAL MEALS TO AUTHORIZE" Q
 | 
|---|
| 7 |  K DIR S DIR("A")="Select Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR
 | 
|---|
| 8 |  Q:$D(DIRUT)  S FHCLST=Y
 | 
|---|
| 9 |  W ! K DIR S DIR("A")="Authorize or Deny? "
 | 
|---|
| 10 |  S DIR(0)="SAO^A:AUTHORIZE;D:DENY",DIR("B")="A" D ^DIR
 | 
|---|
| 11 |  Q:$D(DIRUT)  S FHSTAT=Y
 | 
|---|
| 12 |  I FHSTAT="D" W ! K DIR S DIR("A")="Comment: ",DIR(0)="FA^1:80" D ^DIR S FHCOMM=Y
 | 
|---|
| 13 |  I FHCOMM="^" W !!?3,"Changes NOT saved!",! H 2 Q
 | 
|---|
| 14 |  W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
 | 
|---|
| 15 |  Q:$D(DIRUT)  I Y=0 D END Q
 | 
|---|
| 16 |  D SIG^XUSESIG I X1="" W !!?5,"<< Incorrect Electronic Signature!! >>" Q
 | 
|---|
| 17 |  F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC=""  S FHCDT=FHLIST(FHC) D UPD,UPD100
 | 
|---|
| 18 |  W "  ... done" Q
 | 
|---|
| 19 |  Q
 | 
|---|
| 20 | UPD ;Update the status,authorizor,date/time of special meal request
 | 
|---|
| 21 |  D NOW^%DTC S FHTODAY=$E(%,1,12)
 | 
|---|
| 22 |  S DA=$P(FHCDT,U,2),FHDA=DA,DA(1)=$P(FHCDT,U,1),FHDFN=DA(1)
 | 
|---|
| 23 |  S DIE="^FHPT("_DA(1)_",""SM"","
 | 
|---|
| 24 |  S DR="1////^S X=FHSTAT;5////^S X=DUZ;6////^S X=FHTODAY;7////^S X=FHCOMM"
 | 
|---|
| 25 |  D ^DIE
 | 
|---|
| 26 |  D ALERT
 | 
|---|
| 27 |  S FHZN=$G(^FHPT(FHDFN,"SM",FHDA,0))
 | 
|---|
| 28 |  S FHACT="O",FHOPTY="S",FHOPDT=$P(FHTODAY,".",1) D SETSM^FHOMRO2
 | 
|---|
| 29 |  Q
 | 
|---|
| 30 | ALERT ;Send alert back to requestor
 | 
|---|
| 31 |  K XQA S (FHAUDA,FHDFN)=$P(FHCDT,U,1),FHAUSMDT=$P(FHCDT,U,2)
 | 
|---|
| 32 |  S FHREQ=$P($G(^FHPT(FHAUDA,"SM",FHAUSMDT,0)),U,5) I FHREQ="" Q
 | 
|---|
| 33 |  S FHAUSTT=$S(FHSTAT="A":"AUTHORIZED",1:"DENIED")
 | 
|---|
| 34 |  S FHAUNAM=$P($G(^VA(200,DUZ,0)),U,1)
 | 
|---|
| 35 |  D PATNAME^FHOMUTL
 | 
|---|
| 36 |  S XQA(FHREQ)=""
 | 
|---|
| 37 |  S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
 | 
|---|
| 38 |  S XQAMSG=XQAMSG_"SPECIAL MEAL HAS BEEN "_FHAUSTT_" BY "_FHAUNAM
 | 
|---|
| 39 |  D SETUP^XQALERT
 | 
|---|
| 40 |  Q
 | 
|---|
| 41 | UPD100 ;Backdoor message to update file #100 if SM order is denied
 | 
|---|
| 42 |  Q:FHSTAT'="D"
 | 
|---|
| 43 |  D PATNAME^FHOMUTL Q:'DFN
 | 
|---|
| 44 |  S FHCATXT=FHCOMM D CNSM100^FHOMRC2
 | 
|---|
| 45 |  Q
 | 
|---|
| 46 | END ;
 | 
|---|
| 47 |  K FHAUDA,FHAUNAM,FHAUSMDT,FHAUSTT,FHS,FHSTAT Q
 | 
|---|