FHOMRC2 ;Hines OIFO/RTK BACKDOOR CANCEL OUTPATIENT MEALS ;4/27/05 10:05
;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
;
CNRM100 ;Backdoor message to update file #100 with RM cancel order
S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,12)
S FHMPNUM=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,6)
S FHDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
S FILL="R;"_FHMPNUM_";"_FHDT_";"_FHDT_";;"
D CHECK
I FHACTV=0 D CAN
I FHACTV=1 D CANOCC
ASSOC I $D(^FHPT(FHDFN,"OP",FHRNUM,1)) D CNAO100,CANAO^FHOMRC1
I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D CNEL100,CANEL^FHOMRC1
I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D CNTF100,CANTF^FHOMRC1
Q
CNAO100 ;Backdoor message to update file #100 with AO cancel order
S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,1)),U,4),FILL="A;"_FHRNUM D CAN Q
CNEL100 ;Backdoor message to update file #100 with EL cancel order
S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,2)),U,5),FILL="E;"_FHRNUM D CAN Q
CNTF100 ;Backdoor message to update file #100 with TF cancel order
S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,3)),U,4),FILL="T;"_FHRNUM D CAN Q
CNIP100 ;Backdoor message to update file #100 with IP cancel order
S FHORN=$P($G(^FHPT(FHDFN,0)),U,6),FILL="I;CANCEL" D CAN Q
CNSM100 ;Backdoor message to update file #100 with SM cancel order
S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,0)),U,12),FILL="S;"_FHDA D CAN
;if an SM E/L Tray exists cancel that too:
CNSMEL S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,1)),U,4) I FHORN="" Q
S FILL="G;"_FHDA D CAN Q
CAN ;
Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
Q:'DFN D MSHCA^FHOMUTL,EVSEND^FHWOR
Q
CANOCC ; If cancelling occurences of RM (not ALL) then send "XX" message
; instead of "OC" which will cancel the entire order in CPRS.
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=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
S FHOSTDT=$$FMTHL7^XLFDT(FHOSTDT)
S MSG(4)="ORC|XX|"_FHORN_"^OR|"_FILL_"^FH||||^^^"_FHOSTDT_"^"_FHOSTDT
S MSG(5)="ODS|||^^^FH-X^Meal Canceled^99OTH|"
D EVSEND^FHWOR
Q
CHECK ; Check if there are other "active" RM's to determine if entire order
; should be cancelled
S FHACTV=0,FHMPNUM=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,6)
F FHINDX=0:0 S FHINDX=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHINDX)) Q:FHINDX'>0!(FHACTV=1) D
.I $P($G(^FHPT(FHDFN,"OP",FHINDX,0)),U,1)<DT Q
.I $P($G(^FHPT(FHDFN,"OP",FHINDX,0)),U,15)'="C" S FHACTV=1
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMRC2 2457 printed Dec 13, 2024@01:52:55 Page 2
FHOMRC2 ;Hines OIFO/RTK BACKDOOR CANCEL OUTPATIENT MEALS ;4/27/05 10:05
+1 ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
+2 ;
CNRM100 ;Backdoor message to update file #100 with RM cancel order
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,12)
+2 SET FHMPNUM=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,6)
+3 SET FHDT=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
+4 SET FILL="R;"_FHMPNUM_";"_FHDT_";"_FHDT_";;"
+5 DO CHECK
+6 IF FHACTV=0
DO CAN
+7 IF FHACTV=1
DO CANOCC
ASSOC IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,1))
DO CNAO100
DO CANAO^FHOMRC1
+1 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,2))
DO CNEL100
DO CANEL^FHOMRC1
+2 IF $DATA(^FHPT(FHDFN,"OP",FHRNUM,3))
DO CNTF100
DO CANTF^FHOMRC1
+3 QUIT
CNAO100 ;Backdoor message to update file #100 with AO cancel order
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,1)),U,4)
SET FILL="A;"_FHRNUM
DO CAN
QUIT
CNEL100 ;Backdoor message to update file #100 with EL cancel order
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,2)),U,5)
SET FILL="E;"_FHRNUM
DO CAN
QUIT
CNTF100 ;Backdoor message to update file #100 with TF cancel order
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,3)),U,4)
SET FILL="T;"_FHRNUM
DO CAN
QUIT
CNIP100 ;Backdoor message to update file #100 with IP cancel order
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,0)),U,6)
SET FILL="I;CANCEL"
DO CAN
QUIT
CNSM100 ;Backdoor message to update file #100 with SM cancel order
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"SM",FHDA,0)),U,12)
SET FILL="S;"_FHDA
DO CAN
+2 ;if an SM E/L Tray exists cancel that too:
CNSMEL SET FHORN=$PIECE($GET(^FHPT(FHDFN,"SM",FHDA,1)),U,4)
IF FHORN=""
QUIT
+1 SET FILL="G;"_FHDA
DO CAN
QUIT
CAN ;
+1 ;must have CPRSv26 for O.M. backdoor
if '$$PATCH^XPDUTL("OR*3.0*215")
QUIT
+2 if 'DFN
QUIT
DO MSHCA^FHOMUTL
DO EVSEND^FHWOR
+3 QUIT
CANOCC ; If cancelling occurences of RM (not ALL) then send "XX" message
+1 ; instead of "OC" which will cancel the entire order in CPRS.
+2 ;must have CPRSv26 for O.M. backdoor
if '$$PATCH^XPDUTL("OR*3.0*215")
QUIT
+3 ;Sets MSG(1), MSG(2) & MSG(3) for OM
if 'DFN
QUIT
KILL MSG
DO MSHOM^FHOMUTL
+4 SET FHOSTDT=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
+5 SET FHOSTDT=$$FMTHL7^XLFDT(FHOSTDT)
+6 SET MSG(4)="ORC|XX|"_FHORN_"^OR|"_FILL_"^FH||||^^^"_FHOSTDT_"^"_FHOSTDT
+7 SET MSG(5)="ODS|||^^^FH-X^Meal Canceled^99OTH|"
+8 DO EVSEND^FHWOR
+9 QUIT
CHECK ; Check if there are other "active" RM's to determine if entire order
+1 ; should be cancelled
+2 SET FHACTV=0
SET FHMPNUM=$PIECE($GET(^FHPT(FHDFN,"OP",FHRNUM,0)),U,6)
+3 FOR FHINDX=0:0
SET FHINDX=$ORDER(^FHPT(FHDFN,"OP","C",FHMPNUM,FHINDX))
if FHINDX'>0!(FHACTV=1)
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHINDX,0)),U,1)<DT
QUIT
+5 IF $PIECE($GET(^FHPT(FHDFN,"OP",FHINDX,0)),U,15)'="C"
SET FHACTV=1
+6 QUIT
End DoDot:1
+7 QUIT
