FHOMRC2.m

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

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