FHOMSR1 ;Hines OIFO/RTK SPECIAL MEALS REQUEST MEAL ;4/02/03 15:05
;;5.5;DIETETICS;**2,5,11**;Jan 28, 2005;Build 4
;
S (FHORN,FHDIET)="",FHKEY=0,FHMSG1="S"
D ^FHOMDPA I FHDFN="" Q
I '$D(^FHPT(FHDFN,0)) W !!,"UNKNOWN SELECTION !" Q
D SMSTAT^FHOMUTL I FHSTAT="P" D MSG1 Q
I $D(^XUSEC("FHAUTH",DUZ)) S FHKEY=1
LOC ;Prompt for outpatient location
W ! D OUTLOC^FHOMUTL I FHLOC="" D EXMSG^FHOMUTL Q
W ! D RMBED^FHOMUTL
DIET ;Prompt for diet
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
MEAL ;Prompt for meal
K DIR,DIC S DIR("A")="Select Meal: "
S DIR(0)="SAO^B:Breakfast;N:Noon;E:Evening"
D ^DIR I $D(DIRUT) D EXMSG^FHOMUTL Q
I Y'=-1 S FHMEAL=Y
D CHECKRM I FHRMYES=1 D MSG2 Q
W ! 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
D NOW^%DTC S FHNOW=%,STDT=DT,FHLTFLG=0 D SMGM^FHOMRO2
I SKIP=1 D EXMSG^FHOMUTL Q
S FHQEL=1 I FHLTFLG=1 S FHSM=FHNOW,FHEL="L",FHQEL=0 D LATE I FHQEL=1 D EXMSG^FHOMUTL Q
S FHSTAT=$S(FHKEY=1:"A",1:"P") D SETNODE,UPD100
I FHQEL=0 D UPDE100
D OKMSG^FHOMUTL
I FHKEY=1 D PRINT
I FHKEY=0 D ALERT
D END Q
PRINT ;If user has key allow printing without sending alert to authorizor(s)
W ! S DIR(0)="YA",DIR("B")="Y",DIR("A")="Print Voucher? " D ^DIR
Q:$D(DIRUT) S PRINT=Y I PRINT'=1 Q
S FHCDT=FHDFN_"^"_FHNOW,FHREQPR=1 D DEV^FHOMSP1 K FHREQPR Q
ALERT ;Send alert to 15 Authorizors set up in file #119.9 (fields 9-13,40-49)
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)
F A=1:1:15 S AB=$P(FHAU15,U,A) I AB'="" S XQA(AB)=""
I '$D(XQA) D
.W !!?5,"NOTICE: No 'Authorizing Person(s)' defined in site "
.W !!?5,"parameter (#119.9) file -- NO ALERT SENT",!! Q
D PATNAME^FHOMUTL
S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
S XQAMSG=XQAMSG_"Special Meal needs authorizing" D SETUP^XQALERT
Q
SETNODE ;
S AUDUZ=$S(FHSTAT="A":DUZ,1:""),AUFHNOW=$S(FHSTAT="A":FHNOW,1:"")
S (FHSMID,Y)=FHNOW K DIC,DO S DA(1)=FHDFN,DIC="^FHPT("_DA(1)_",""SM"","
S DIC(0)="L",DIC("P")=$P(^DD(115,17,0),U,2),X=+Y,DINUM=X
D FILE^DICN I Y=-1 Q
K DIE S DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
S DA=+Y,FHDA=DA
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"
D ^DIE
I FHQEL=0 D ORDEL
S FHZN=$G(^FHPT(FHDFN,"SM",FHDA,0))
S FHACT="O",FHOPTY="S",FHOPDT=$P(FHNOW,".",1) D SETSM^FHOMRO2
Q
MSG1 ;
W !!,"This patient already has a pending Special Meal request for "
S DTP=DT D DTP^FH W DTP," " Q
MSG2 ;
W !!,"This patient already has a Recurring Meal ordered for "
S DTP=DT D DTP^FH W DTP," "
W $S(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening") Q
CHECKRM ; Check if the OP has an existing RM for this date/meal
S FHRMYES=0
F FHZ=0:0 S FHZ=$O(^FHPT(FHDFN,"OP","B",DT,FHZ)) Q:FHZ'>0!(FHZ>DT) D
.I $P($G(^FHPT(FHDFN,"OP",FHZ,0)),U,4)'=FHMEAL Q
.I $P($G(^FHPT(FHDFN,"OP",FHZ,0)),U,15)="C" Q
.S FHRMYES=1
Q
END ;Kill local variables before exiting
K A,AA,AB,BAG,CCC,CONT,DIC,DIR,ENDL,ENDT,FHDFN,FHDAYS,FHDEF
K FHDIET,FHDIETS,FHSTAT,FHZ,STDT,STDTIM Q
;
LATE ;
S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8),FHCOMM1=$G(^FH(119.73,FHCOMM,1))
S FH1=$S(FHMEAL="B":1,FHMEAL="N":7,1:13) I FHEL="L" S FH1=FH1+3
TIME S FH3=FH1+2,FHCNT=0 F FHT=FH1:1:FH3 D
.I $P(FHCOMM1,U,FHT)="" Q
.S FHCNT=FHCNT+1,FHTM(FHCNT)=$P(FHCOMM1,U,FHT)
W !,"Select Time: ( " F J=1:1:FHCNT W J,"=",FHTM(J)," "
R ") ",FHS:DTIME I FHS=""!(FHS["^") S FHQEL=1 Q
I (FHS'?1N)!(FHS<1)!(FHS>FHCNT) W !!,"Invalid time selection!" D TIME Q
S FHTIME=FHTM(FHS),X=$E(FHNOW,1,7)_"@"_FHTIME,%DT="XT" D ^%DT S FHTRAY=Y
D NOW^%DTC I FHTRAY<% W !!,"Cannot order for a time before now!" D TIME Q
S FHBAG="N" I $P($G(^FH(119.73,FHCOMM,2)),U,10)="Y" D
. K DIR S DIR(0)="SAO^Y:Yes;N:No",DIR("A")="Bagged Meal? ",DIR("B")="N"
. D ^DIR I $D(DIRUT) S FHQEL=1 Q
. S FHBAG=Y
Q
ORDEL ;
S DA=FHSM,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""SM"","
S DR="8////^S X=FHTIME;9////^S X=FHBAG;10////^S X=DUZ" D ^DIE
Q
UPD100 ;Backdoor message to update file #100 with a new SM 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 FILL="S;"_FHNOW
S FHOMEAL=$S(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
S FHDIETNM=$P($G(^FH(111,FHDIET,0)),U,1),FHODT=$$FMTHL7^XLFDT(FHNOW)
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHODT
S MSG(5)="ODS|S|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHDIETNM_"^99FHD|"
D EVSEND^FHWOR
Q
UPDE100 ;Backdoor message to update file #100 with a new SM Late Tray 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 FILL="G;"_FHNOW,FHODT=$$FMTHL7^XLFDT(FHNOW)
S FHTRAY=$$FMTHL7^XLFDT(FHTRAY)
S FHOMELN=FHMEAL_"L"_FHS,FHOBAG="" I FHBAG="Y" S FHOBAG="bagged"
S MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHTRAY_"^"_FHTRAY_"||||||||"_FHODT
S MSG(5)="ODT|LATE|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
D EVSEND^FHWOR
Q
FHOMSR1 ;Hines OIFO/RTK SPECIAL MEALS REQUEST MEAL ;4/02/03 15:05
+1 ;;5.5;DIETETICS;**2,5,11**;Jan 28, 2005;Build 4
+2 ;
+3 SET (FHORN,FHDIET)=""
SET FHKEY=0
SET FHMSG1="S"
+4 DO ^FHOMDPA
IF FHDFN=""
QUIT
+5 IF '$DATA(^FHPT(FHDFN,0))
WRITE !!,"UNKNOWN SELECTION !"
QUIT
+6 DO SMSTAT^FHOMUTL
IF FHSTAT="P"
DO MSG1
QUIT
+7 IF $DATA(^XUSEC("FHAUTH",DUZ))
SET FHKEY=1
LOC ;Prompt for outpatient location
+1 WRITE !
DO OUTLOC^FHOMUTL
IF FHLOC=""
DO EXMSG^FHOMUTL
QUIT
+2 WRITE !
DO RMBED^FHOMUTL
DIET ;Prompt for diet
+1 DO DIETLST^FHOMUTL
+2 IF FHDEF=""
WRITE !!,"NO DEFAULT OUTPATIENT DIET SET!!",!
QUIT
+3 SET FHDEF=$PIECE($GET(^FH(111,FHDEF,0)),U,1)
+4 KILL DIC
SET DIC="^FH(111,"
SET DIC("A")="Select DIET NAME: "
SET DIC(0)="AEMQZ"
+5 SET DIC("B")=FHDEF
SET DIC("S")="I $D(FHDIETS(+Y))"
DO ^DIC
+6 IF $DATA(DUOUT)
DO EXMSG^FHOMUTL
QUIT
+7 IF Y=-1
DO EXMSG^FHOMUTL
QUIT
+8 SET FHDIET=+Y
MEAL ;Prompt for meal
+1 KILL DIR,DIC
SET DIR("A")="Select Meal: "
+2 SET DIR(0)="SAO^B:Breakfast;N:Noon;E:Evening"
+3 DO ^DIR
IF $DATA(DIRUT)
DO EXMSG^FHOMUTL
QUIT
+4 IF Y'=-1
SET FHMEAL=Y
+5 DO CHECKRM
IF FHRMYES=1
DO MSG2
QUIT
+6 WRITE !
KILL DIR
SET DIR("A")="Is this correct?: "
SET DIR(0)="YA"
SET DIR("B")="Y"
+7 DO ^DIR
+8 SET CONT=Y
IF CONT'=1
DO EXMSG^FHOMUTL
QUIT
+9 DO NOW^%DTC
SET FHNOW=%
SET STDT=DT
SET FHLTFLG=0
DO SMGM^FHOMRO2
+10 IF SKIP=1
DO EXMSG^FHOMUTL
QUIT
+11 SET FHQEL=1
IF FHLTFLG=1
SET FHSM=FHNOW
SET FHEL="L"
SET FHQEL=0
DO LATE
IF FHQEL=1
DO EXMSG^FHOMUTL
QUIT
+12 SET FHSTAT=$SELECT(FHKEY=1:"A",1:"P")
DO SETNODE
DO UPD100
+13 IF FHQEL=0
DO UPDE100
+14 DO OKMSG^FHOMUTL
+15 IF FHKEY=1
DO PRINT
+16 IF FHKEY=0
DO ALERT
+17 DO END
QUIT
PRINT ;If user has key allow printing without sending alert to authorizor(s)
+1 WRITE !
SET DIR(0)="YA"
SET DIR("B")="Y"
SET DIR("A")="Print Voucher? "
DO ^DIR
+2 IF $DATA(DIRUT)
QUIT
SET PRINT=Y
IF PRINT'=1
QUIT
+3 SET FHCDT=FHDFN_"^"_FHNOW
SET FHREQPR=1
DO DEV^FHOMSP1
KILL FHREQPR
QUIT
ALERT ;Send alert to 15 Authorizors set up in file #119.9 (fields 9-13,40-49)
+1 KILL XQA,FHAU15
SET FHAU15=$PIECE($GET(^FH(119.9,1,0)),U,7,11)_"^"_$PIECE($GET(^FH(119.9,1,1)),U,11,20)
+2 FOR A=1:1:15
SET AB=$PIECE(FHAU15,U,A)
IF AB'=""
SET XQA(AB)=""
+3 IF '$DATA(XQA)
Begin DoDot:1
+4 WRITE !!?5,"NOTICE: No 'Authorizing Person(s)' defined in site "
+5 WRITE !!?5,"parameter (#119.9) file -- NO ALERT SENT",!!
QUIT
End DoDot:1
+6 DO PATNAME^FHOMUTL
+7 SET XQAMSG=$EXTRACT(FHPTNM,1,9)_" ("_$EXTRACT(FHPTNM,1,1)_$PIECE(FHSSN,"-",3)_"): "
+8 SET XQAMSG=XQAMSG_"Special Meal needs authorizing"
DO SETUP^XQALERT
+9 QUIT
SETNODE ;
+1 SET AUDUZ=$SELECT(FHSTAT="A":DUZ,1:"")
SET AUFHNOW=$SELECT(FHSTAT="A":FHNOW,1:"")
+2 SET (FHSMID,Y)=FHNOW
KILL DIC,DO
SET DA(1)=FHDFN
SET DIC="^FHPT("_DA(1)_",""SM"","
+3 SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(115,17,0),U,2)
SET X=+Y
SET DINUM=X
+4 DO FILE^DICN
IF Y=-1
QUIT
+5 KILL DIE
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""SM"","
+6 SET DA=+Y
SET FHDA=DA
+7 SET 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"
+8 DO ^DIE
+9 IF FHQEL=0
DO ORDEL
+10 SET FHZN=$GET(^FHPT(FHDFN,"SM",FHDA,0))
+11 SET FHACT="O"
SET FHOPTY="S"
SET FHOPDT=$PIECE(FHNOW,".",1)
DO SETSM^FHOMRO2
+12 QUIT
MSG1 ;
+1 WRITE !!,"This patient already has a pending Special Meal request for "
+2 SET DTP=DT
DO DTP^FH
WRITE DTP," "
QUIT
MSG2 ;
+1 WRITE !!,"This patient already has a Recurring Meal ordered for "
+2 SET DTP=DT
DO DTP^FH
WRITE DTP," "
+3 WRITE $SELECT(FHMEAL="B":"Breakfast",FHMEAL="N":"Noon",1:"Evening")
QUIT
CHECKRM ; Check if the OP has an existing RM for this date/meal
+1 SET FHRMYES=0
+2 FOR FHZ=0:0
SET FHZ=$ORDER(^FHPT(FHDFN,"OP","B",DT,FHZ))
IF FHZ'>0!(FHZ>DT)
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHZ,0)),U,4)'=FHMEAL
QUIT
+4 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHZ,0)),U,15)="C"
QUIT
+5 SET FHRMYES=1
End DoDot:1
+6 QUIT
END ;Kill local variables before exiting
+1 KILL A,AA,AB,BAG,CCC,CONT,DIC,DIR,ENDL,ENDT,FHDFN,FHDAYS,FHDEF
+2 KILL FHDIET,FHDIETS,FHSTAT,FHZ,STDT,STDTIM
QUIT
+3 ;
LATE ;
+1 SET FHCOMM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,8)
SET FHCOMM1=$GET(^FH(119.73,FHCOMM,1))
+2 SET FH1=$SELECT(FHMEAL="B":1,FHMEAL="N":7,1:13)
IF FHEL="L"
SET FH1=FH1+3
TIME SET FH3=FH1+2
SET FHCNT=0
FOR FHT=FH1:1:FH3
Begin DoDot:1
+1 IF $PIECE(FHCOMM1,U,FHT)=""
QUIT
+2 SET FHCNT=FHCNT+1
SET FHTM(FHCNT)=$PIECE(FHCOMM1,U,FHT)
End DoDot:1
+3 WRITE !,"Select Time: ( "
FOR J=1:1:FHCNT
WRITE J,"=",FHTM(J)," "
+4 READ ") ",FHS:DTIME
IF FHS=""!(FHS["^")
SET FHQEL=1
QUIT
+5 IF (FHS'?1N)!(FHS<1)!(FHS>FHCNT)
WRITE !!,"Invalid time selection!"
DO TIME
QUIT
+6 SET FHTIME=FHTM(FHS)
SET X=$EXTRACT(FHNOW,1,7)_"@"_FHTIME
SET %DT="XT"
DO ^%DT
SET FHTRAY=Y
+7 DO NOW^%DTC
IF FHTRAY<%
WRITE !!,"Cannot order for a time before now!"
DO TIME
QUIT
+8 SET FHBAG="N"
IF $PIECE($GET(^FH(119.73,FHCOMM,2)),U,10)="Y"
Begin DoDot:1
+9 KILL DIR
SET DIR(0)="SAO^Y:Yes;N:No"
SET DIR("A")="Bagged Meal? "
SET DIR("B")="N"
+10 DO ^DIR
IF $DATA(DIRUT)
SET FHQEL=1
QUIT
+11 SET FHBAG=Y
End DoDot:1
+12 QUIT
ORDEL ;
+1 SET DA=FHSM
SET DA(1)=FHDFN
SET DIE="^FHPT("_DA(1)_",""SM"","
+2 SET DR="8////^S X=FHTIME;9////^S X=FHBAG;10////^S X=DUZ"
DO ^DIE
+3 QUIT
UPD100 ;Backdoor message to update file #100 with a new SM order
+1 ;must have CPRSv26 for O.M. backdoor
IF '$$PATCH^XPDUTL("OR*3.0*215")
QUIT
+2 ;Sets MSG(1), MSG(2) & MSG(3) for OM
IF 'DFN
QUIT
KILL MSG
DO MSHOM^FHOMUTL
+3 SET FILL="S;"_FHNOW
+4 SET FHOMEAL=$SELECT(FHMEAL="B":1,FHMEAL="N":3,FHMEAL="E":5,1:"")
+5 SET FHDIETNM=$PIECE($GET(^FH(111,FHDIET,0)),U,1)
SET FHODT=$$FMTHL7^XLFDT(FHNOW)
+6 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHODT_"^"_FHODT_"||||||||"_FHODT
+7 SET MSG(5)="ODS|S|"_FHOMEAL_"|^^^"_FHDIET_"^"_FHDIETNM_"^99FHD|"
+8 DO EVSEND^FHWOR
+9 QUIT
UPDE100 ;Backdoor message to update file #100 with a new SM Late Tray order
+1 ;must have CPRSv26 for O.M. backdoor
IF '$$PATCH^XPDUTL("OR*3.0*215")
QUIT
+2 ;Sets MSG(1), MSG(2) & MSG(3) for OM
IF 'DFN
QUIT
KILL MSG
DO MSHOM^FHOMUTL
+3 SET FILL="G;"_FHNOW
SET FHODT=$$FMTHL7^XLFDT(FHNOW)
+4 SET FHTRAY=$$FMTHL7^XLFDT(FHTRAY)
+5 SET FHOMELN=FHMEAL_"L"_FHS
SET FHOBAG=""
IF FHBAG="Y"
SET FHOBAG="bagged"
+6 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^^^"_FHTRAY_"^"_FHTRAY_"||||||||"_FHODT
+7 SET MSG(5)="ODT|LATE|^^^"_FHOMELN_"^^99FHD|"_FHOBAG
+8 DO EVSEND^FHWOR
+9 QUIT
