| 1 | FHOMRC2 ;Hines OIFO/RTK BACKDOOR CANCEL OUTPATIENT MEALS ;4/27/05 10:05
|
|---|
| 2 | ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
|
|---|
| 3 | ;
|
|---|
| 4 | CNRM100 ;Backdoor message to update file #100 with RM cancel order
|
|---|
| 5 | S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,12)
|
|---|
| 6 | S FHMPNUM=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,6)
|
|---|
| 7 | S FHDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
|
|---|
| 8 | S FILL="R;"_FHMPNUM_";"_FHDT_";"_FHDT_";;"
|
|---|
| 9 | D CHECK
|
|---|
| 10 | I FHACTV=0 D CAN
|
|---|
| 11 | I FHACTV=1 D CANOCC
|
|---|
| 12 | ASSOC I $D(^FHPT(FHDFN,"OP",FHRNUM,1)) D CNAO100,CANAO^FHOMRC1
|
|---|
| 13 | I $D(^FHPT(FHDFN,"OP",FHRNUM,2)) D CNEL100,CANEL^FHOMRC1
|
|---|
| 14 | I $D(^FHPT(FHDFN,"OP",FHRNUM,3)) D CNTF100,CANTF^FHOMRC1
|
|---|
| 15 | Q
|
|---|
| 16 | CNAO100 ;Backdoor message to update file #100 with AO cancel order
|
|---|
| 17 | S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,1)),U,4),FILL="A;"_FHRNUM D CAN Q
|
|---|
| 18 | CNEL100 ;Backdoor message to update file #100 with EL cancel order
|
|---|
| 19 | S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,2)),U,5),FILL="E;"_FHRNUM D CAN Q
|
|---|
| 20 | CNTF100 ;Backdoor message to update file #100 with TF cancel order
|
|---|
| 21 | S FHORN=$P($G(^FHPT(FHDFN,"OP",FHRNUM,3)),U,4),FILL="T;"_FHRNUM D CAN Q
|
|---|
| 22 | CNIP100 ;Backdoor message to update file #100 with IP cancel order
|
|---|
| 23 | S FHORN=$P($G(^FHPT(FHDFN,0)),U,6),FILL="I;CANCEL" D CAN Q
|
|---|
| 24 | CNSM100 ;Backdoor message to update file #100 with SM cancel order
|
|---|
| 25 | S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,0)),U,12),FILL="S;"_FHDA D CAN
|
|---|
| 26 | ;if an SM E/L Tray exists cancel that too:
|
|---|
| 27 | CNSMEL S FHORN=$P($G(^FHPT(FHDFN,"SM",FHDA,1)),U,4) I FHORN="" Q
|
|---|
| 28 | S FILL="G;"_FHDA D CAN Q
|
|---|
| 29 | CAN ;
|
|---|
| 30 | Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
|---|
| 31 | Q:'DFN D MSHCA^FHOMUTL,EVSEND^FHWOR
|
|---|
| 32 | Q
|
|---|
| 33 | CANOCC ; If cancelling occurences of RM (not ALL) then send "XX" message
|
|---|
| 34 | ; instead of "OC" which will cancel the entire order in CPRS.
|
|---|
| 35 | Q:'$$PATCH^XPDUTL("OR*3.0*215") ;must have CPRSv26 for O.M. backdoor
|
|---|
| 36 | Q:'DFN K MSG D MSHOM^FHOMUTL ;Sets MSG(1), MSG(2) & MSG(3) for OM
|
|---|
| 37 | S FHOSTDT=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,1)
|
|---|
| 38 | S FHOSTDT=$$FMTHL7^XLFDT(FHOSTDT)
|
|---|
| 39 | S MSG(4)="ORC|XX|"_FHORN_"^OR|"_FILL_"^FH||||^^^"_FHOSTDT_"^"_FHOSTDT
|
|---|
| 40 | S MSG(5)="ODS|||^^^FH-X^Meal Canceled^99OTH|"
|
|---|
| 41 | D EVSEND^FHWOR
|
|---|
| 42 | Q
|
|---|
| 43 | CHECK ; Check if there are other "active" RM's to determine if entire order
|
|---|
| 44 | ; should be cancelled
|
|---|
| 45 | S FHACTV=0,FHMPNUM=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,6)
|
|---|
| 46 | F FHINDX=0:0 S FHINDX=$O(^FHPT(FHDFN,"OP","C",FHMPNUM,FHINDX)) Q:FHINDX'>0!(FHACTV=1) D
|
|---|
| 47 | .I $P($G(^FHPT(FHDFN,"OP",FHINDX,0)),U,1)<DT Q
|
|---|
| 48 | .I $P($G(^FHPT(FHDFN,"OP",FHINDX,0)),U,15)'="C" S FHACTV=1
|
|---|
| 49 | .Q
|
|---|
| 50 | Q
|
|---|
