- LROR6 ;SLC/DCM - EDIT LAB ORDERS FOR OE/RR ;8/11/97
- ;;5.2;LAB SERVICE;**100,121,202**;Sep 27, 1994
- DC(REQ,STAT) ;DC reason
- ;REQ=1 to require a response
- ;STAT=1 to set the variable LRMSTATI for sending status back to OE/RR.
- I $$VER^LR7OU1<3 Q ;OE/RR 2.5 Check
- N DEF,R,PKG,X,OK
- S PKG=$O(^DIC(9.4,"B","LAB SERVICE",0))
- S DEF=$P($G(^LAB(69.9,1,"OR")),"^",2)
- AGAIN S X=$$DC^ORX1(DEF,+$G(REQ),PKG,"Cancellation Reason"),LRNATURE=$S(X:"^^^"_$P(X,"^",1,2)_"^99ORR",1:-1)
- I $G(STAT)=1 S OK=1,LRMSTATI=$P(X,"^",9) I LRMSTATI,LRMSTATI'=1 D G:'OK AGAIN
- . W !,"This Cancellation Reason will ONLY remove the accession.",!,"The Doctor's original order will NOT be canceled, so that it may be"
- . W !,"re-accessioned at a later time. OK"
- . ;"To later cancel the order, use the option: ",!," Delete entire order or individual tests",!
- . S %=1 D YN^DICN I %'=1 S OK=0
- . I %=0 W !!,"You may enter a different Cancellation Reason, if you wish.",!
- Q
- DC1(REASON,TEXT) ;Set HL7 String for DC Reason
- ;REASON=ptr to DC Reason (100.03)
- ;TEXT=free text reason to be associated with order (optional)
- I $$VER^LR7OU1<3 Q "" ;OE/RR 2.5 Check
- Q:'$G(REASON) ""
- N X S X=$G(^ORD(100.03,REASON,0)),X="^^^"_REASON_"^"_$S($L($G(TEXT)):TEXT,1:$P(X,"^"))_"^99ORR"
- Q X
- NEW(REQ) ;Get Nature of order
- ;REQ=1 to require a response
- I $$VER^LR7OU1<3 Q ;OE/RR 2.5 Check
- N DEF,X
- S DEF=$P($G(^LAB(69.9,1,"OR")),"^"),X=$$NA^ORX1(DEF,+$G(REQ),"B","Nature of Order/Change"),LRNATURE=$S(X:$P(X,"^",1,2)_"^99ORN",1:-1)
- Q
- NEW1(NATURE) ;Set HL7 String for Nature of Order
- ;NATURE=ptr to Nature of Order (100.02)
- I $$VER^LR7OU1<3 Q "" ;OE/RR 2.5 Check
- Q:'$G(NATURE)
- N X S X=$G(^ORD(100.02,NATURE,0)),X="^^^"_NATURE_"^"_$P(X,"^")_"^99ORN"
- Q X
- EN ;OE/RR 2.5 Nature of Order processes
- I ORSTS=""!(+ORSTS=11) D EDITUR^LROR6A Q
- I ORGY'=0 S OREND=0 D C^LROR3 Q
- EDIT ;Edit orders for OE/RR 2.5
- S LRODT=$P(ORPK,"^"),LRSN=$P(ORPK,"^",2),I=$P(ORPK,"^",3)
- S X="" W !!,"Released laboratory orders are UNEDITABLE." Q:+ORSTS=6 W !,"You may use this action to ADD a test to the existing lab order number."
- N ORACTION,ORPARAM S ORNDO=1 D EN^LROR9
- K LRODT,LRSN,LRSX
- Q
- OT ;OE/RR 2.5 Natuer of Order processing
- S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
- S DIR("?",2)="A notification will be sent to the requesting clinician to electronically"
- S DIR("?",3)="sign this action, and a copy of this action will be printed in the"
- S DIR("?",4)="ward/clinic to be placed in the chart, unless specified as a 'CORRECTION'"
- S DIR("?",5)="(not affecting the original order), or 'WRITTEN REQUEST' (Signed on chart)."
- S DIR("?",6)=""
- S DIR("?")="Enter reason: (C)ORRECTION, (W)RITTEN, (V)ERBAL, (P)HONED"
- S DIR("A")="NATURE OF ORDER/CHANGE: "
- S DIR("B")=$S($D(^XUSEC("LRLAB",DUZ)):"CORRECTION",1:"WRITTEN")
- S DIR(0)="SA^C:CORRECTION (internal to lab);W:WRITTEN REQUEST (Signed on chart);P:TELEPHONED REQUEST;V:VERBAL REQUEST"
- D ^DIR K DIR S ORNATR=$S($L(Y)&(Y="P"!(Y="V")):Y,1:"C") ;Correction=""
- I "VPWC"'[Y W !,"NATURE OF ORDER/CHANGE must be entered",$C(7),! G OT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROR6 3138 printed Feb 18, 2025@23:44:36 Page 2
- LROR6 ;SLC/DCM - EDIT LAB ORDERS FOR OE/RR ;8/11/97
- +1 ;;5.2;LAB SERVICE;**100,121,202**;Sep 27, 1994
- DC(REQ,STAT) ;DC reason
- +1 ;REQ=1 to require a response
- +2 ;STAT=1 to set the variable LRMSTATI for sending status back to OE/RR.
- +3 ;OE/RR 2.5 Check
- IF $$VER^LR7OU1<3
- QUIT
- +4 NEW DEF,R,PKG,X,OK
- +5 SET PKG=$ORDER(^DIC(9.4,"B","LAB SERVICE",0))
- +6 SET DEF=$PIECE($GET(^LAB(69.9,1,"OR")),"^",2)
- AGAIN SET X=$$DC^ORX1(DEF,+$GET(REQ),PKG,"Cancellation Reason")
- SET LRNATURE=$SELECT(X:"^^^"_$PIECE(X,"^",1,2)_"^99ORR",1:-1)
- +1 IF $GET(STAT)=1
- SET OK=1
- SET LRMSTATI=$PIECE(X,"^",9)
- IF LRMSTATI
- IF LRMSTATI'=1
- Begin DoDot:1
- +2 WRITE !,"This Cancellation Reason will ONLY remove the accession.",!,"The Doctor's original order will NOT be canceled, so that it may be"
- +3 WRITE !,"re-accessioned at a later time. OK"
- +4 ;"To later cancel the order, use the option: ",!," Delete entire order or individual tests",!
- +5 SET %=1
- DO YN^DICN
- IF %'=1
- SET OK=0
- +6 IF %=0
- WRITE !!,"You may enter a different Cancellation Reason, if you wish.",!
- End DoDot:1
- if 'OK
- GOTO AGAIN
- +7 QUIT
- DC1(REASON,TEXT) ;Set HL7 String for DC Reason
- +1 ;REASON=ptr to DC Reason (100.03)
- +2 ;TEXT=free text reason to be associated with order (optional)
- +3 ;OE/RR 2.5 Check
- IF $$VER^LR7OU1<3
- QUIT ""
- +4 if '$GET(REASON)
- QUIT ""
- +5 NEW X
- SET X=$GET(^ORD(100.03,REASON,0))
- SET X="^^^"_REASON_"^"_$SELECT($LENGTH($GET(TEXT)):TEXT,1:$PIECE(X,"^"))_"^99ORR"
- +6 QUIT X
- NEW(REQ) ;Get Nature of order
- +1 ;REQ=1 to require a response
- +2 ;OE/RR 2.5 Check
- IF $$VER^LR7OU1<3
- QUIT
- +3 NEW DEF,X
- +4 SET DEF=$PIECE($GET(^LAB(69.9,1,"OR")),"^")
- SET X=$$NA^ORX1(DEF,+$GET(REQ),"B","Nature of Order/Change")
- SET LRNATURE=$SELECT(X:$PIECE(X,"^",1,2)_"^99ORN",1:-1)
- +5 QUIT
- NEW1(NATURE) ;Set HL7 String for Nature of Order
- +1 ;NATURE=ptr to Nature of Order (100.02)
- +2 ;OE/RR 2.5 Check
- IF $$VER^LR7OU1<3
- QUIT ""
- +3 if '$GET(NATURE)
- QUIT
- +4 NEW X
- SET X=$GET(^ORD(100.02,NATURE,0))
- SET X="^^^"_NATURE_"^"_$PIECE(X,"^")_"^99ORN"
- +5 QUIT X
- EN ;OE/RR 2.5 Nature of Order processes
- +1 IF ORSTS=""!(+ORSTS=11)
- DO EDITUR^LROR6A
- QUIT
- +2 IF ORGY'=0
- SET OREND=0
- DO C^LROR3
- QUIT
- EDIT ;Edit orders for OE/RR 2.5
- +1 SET LRODT=$PIECE(ORPK,"^")
- SET LRSN=$PIECE(ORPK,"^",2)
- SET I=$PIECE(ORPK,"^",3)
- +2 SET X=""
- WRITE !!,"Released laboratory orders are UNEDITABLE."
- if +ORSTS=6
- QUIT
- WRITE !,"You may use this action to ADD a test to the existing lab order number."
- +3 NEW ORACTION,ORPARAM
- SET ORNDO=1
- DO EN^LROR9
- +4 KILL LRODT,LRSN,LRSX
- +5 QUIT
- OT ;OE/RR 2.5 Natuer of Order processing
- +1 SET DIR("?",1)="This order/change will be recorded in the patient's electronic record."
- +2 SET DIR("?",2)="A notification will be sent to the requesting clinician to electronically"
- +3 SET DIR("?",3)="sign this action, and a copy of this action will be printed in the"
- +4 SET DIR("?",4)="ward/clinic to be placed in the chart, unless specified as a 'CORRECTION'"
- +5 SET DIR("?",5)="(not affecting the original order), or 'WRITTEN REQUEST' (Signed on chart)."
- +6 SET DIR("?",6)=""
- +7 SET DIR("?")="Enter reason: (C)ORRECTION, (W)RITTEN, (V)ERBAL, (P)HONED"
- +8 SET DIR("A")="NATURE OF ORDER/CHANGE: "
- +9 SET DIR("B")=$SELECT($DATA(^XUSEC("LRLAB",DUZ)):"CORRECTION",1:"WRITTEN")
- +10 SET DIR(0)="SA^C:CORRECTION (internal to lab);W:WRITTEN REQUEST (Signed on chart);P:TELEPHONED REQUEST;V:VERBAL REQUEST"
- +11 ;Correction=""
- DO ^DIR
- KILL DIR
- SET ORNATR=$SELECT($LENGTH(Y)&(Y="P"!(Y="V")):Y,1:"C")
- +12 IF "VPWC"'[Y
- WRITE !,"NATURE OF ORDER/CHANGE must be entered",$CHAR(7),!
- GOTO OT
- +13 QUIT
