- 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 Jan 18, 2025@02:54:08 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