ORX1 ; SLC/DCM - OE/RR Nature of Order entry points ;Apr 24, 2024@07:20:01
;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242,535**;Dec 17, 1997;Build 20
;Reference to ^DIC(9.4,"C" in ICR #2058
;Reference to ^DIC in ICR #10006
;Reference to MIX^DIC1 in ICR #10007
;Reference to ^DIE in ICR #10018
;Reference to ^DIR in ICR #10026
;
NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order
;DEFAULT [not required] =Free text code or pointer to Nature of order (file 100.02).
; Used for default response.
;REQUIRD [not required] =1 to require a response from user,
; =0 (default) not to require response.
;FB [not required] =F for frontdoor,
; =B (default) for backdoor.
; Screens on Frontdoor/Backdoor types.
; Nature of order entries are setup to be available for
; frontdoor or backdoor processing.
;DIRA [not required] =prompt for DIR("A")
; default:"Reason for Order/Change"
;DC [not required] =1 if you want to include 'DC only' types,
; =0 (default) includes all other types except for 'DC only'.
;LIST [not required] =List of 'Nature of Order' codes (from file 100.02)
; allowed. If this is passed, then DC and FB params
; are ignored. Format: code1code2code3
;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS")
;Returned value: ifn^name^code
N DIR,X,Y,DIRUT,DUOUT
S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
S DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the"
S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
S DIR("?",5)=""
S DIR("?",6)=" Enter '??' for more information."
S DIR("?")=" "
S DIR("A")=$S($L($G(DIRA)):DIRA,1:"Reason for Order/Change")
I '$G(DEFAULT),$L($G(DEFAULT)),$O(^ORD(100.02,"C",DEFAULT,0)) S DEFAULT=$O(^(0))
I $G(DEFAULT) S DIR("B")=$S($D(^ORD(100.02,+DEFAULT,0)):$S('$L($G(LIST)):$P(^(0),"^"),1:$S($L($G(LIST))&($G(LIST)[$P(^(0),"^",2)):$P(^(0),"^"),1:""),1:""),1:"") K:DIR("B")="" DIR("B")
S DIR(0)="P^100.02:EMZ"
S:'$D(FB) FB="B" S:FB="" FB="B" S:'$D(DC) DC=0
I $L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0),""^"",2)"
I '$L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),('$P(^(0),""^"",6)!(DC)),"_$S(FB="B":"""XB""[$P(^(0),""^"",5)",FB="F":"""XF""[$P(^(0),""^"",5)",1:0)
S DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
S DIR("??")="^D NA1^ORX1(DIR(""S""))"
OT2 D ^DIR
I 'Y,$G(REQUIRD)=1 W !,"A "_$S($L($G(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$C(7),! G OT2
I Y S $P(Y,"^",3)=$P(^ORD(100.02,+Y,0),"^",2)
Q Y
NA1(SCREEN) ;Executable help for Nature of order
;SCREEN=Mumps code that is used like DIC("S") to screen out entries
N X,X1,Y
W !?30," Require",?43," Print",?56,"Print on"
W !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
W !?2,"------------------------",?29,"-----------",?43,"----------",?56,"--------"
S Y=0 F S Y=$O(^ORD(100.02,Y)) Q:Y<1 I $D(^(Y,0)) X:$D(SCREEN) SCREEN I $T S X=^ORD(100.02,Y,0),X1=$G(^(1)) W !,?2,$P(X,"^"),?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
Q
NA2(SCREEN) ;Get help for DC Reasons
;SCREEN=Mumps code that is used like DIC("S") to screen out entries
N X,X1,I
W !?30," Require",?43," Print",?56,"Print on"
W !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
W !,"------------",?29,"-----------",?43,"----------",?56,"--------"
S I=0 F S I=$O(^ORD(100.03,I)) Q:I<1 I $D(^(I,0)) X:$D(SCREEN) SCREEN I $T S X=^(0) I $P(X,"^",7),$D(^ORD(100.02,$P(X,"^",7),0)) W !,$P(X,"^") S X=^(0),X1=$G(^(1)) D
. W ?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
Q
;
CREATE(X) ; -- Returns 1 or 0, if action should be created or not
N Y Q:'$L($G(X)) 0
I 'X S X=+$O(^ORD(100.02,"C",X,0))
S Y=+$P($G(^ORD(100.02,+X,1)),U)
Q Y
;
SIGSTS(X) ; -- Returns default signature status for nature X
N Y S Y="" G:'$L($G(X)) SIGQ
I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X SIGQ
S Y=$P($G(^ORD(100.02,+X,1)),U,4)
SIGQ Q Y
;
CHART(X) ; -- Returns 1 or 0, print chart copy for nature X
N Y S Y="" G:'$L($G(X)) CHQ
I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X CHQ
S Y=$P($G(^ORD(100.02,+X,1)),U,2)
CHQ Q Y
;
ACTV(X) ; -- Returns 1 or 0, include action in Active Orders
N Y S Y="" G:'$L($G(X)) ACTQ
I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X ACTQ
S Y=$P($G(^ORD(100.02,+X,1)),U,6)
ACTQ Q Y
;
DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason
;DEFAULT=ifn of default reason
;REQ=1 to require a response
;PKG=ptr to file 9.4 to only get reasons for a specific package
;DIRA=Default prompt to be used instead of DIR("A")
N DIR,X,Y,DIRUT,DUOUT
S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
S DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the"
S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
S DIR("?",5)=""
S DIR("?")=" "
S DIR("A")="Reason" I $L($G(DIRA)) S DIR("A")=DIRA
I $G(DEFAULT) S DIR("B")=$S($G(DEFAULT):$S($D(^ORD(100.03,+DEFAULT,0)):$P(^(0),"^"),1:""),1:"")
S DIR(0)="P^100.03:EMZ"
S DIR("S")="I '$P(^(0),""^"",4)"_$S($G(PKG):",$P(^(0),""^"",5)=PKG",1:"")
S DIR("??")="^D NA2^ORX1(DIR(""S""))"
OT1 D ^DIR
I 'Y,$G(REQ)=1 W !,"A REASON FOR DC must be entered",$C(7),! G OT1
Q $S(Y:+Y_"^"_$G(Y(0)),1:Y)
;
EDITDCR ; -- Edit DC Reason
N X,Y,D,DIC,DIE,DR,DA,DLAYGO W !
EDC1 S DIC=100.03,DIC(0)="AELNQM",DIC("A")="Select DC REASON: ",DLAYGO=100.03
S DIC("S")="I $P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0)),D="B^S"
S DIC("DR")=".05////"_+$O(^DIC(9.4,"C","OR",0)) D MIX^DIC1 Q:Y'>0
S DA=+Y,DIE=DIC,DR=".01;.03;.04;.07" D ^DIE
W ! G EDC1
Q
;
EDITNAT ; -- Edit allowable Nature of Order fields
N X,Y,DA,DR,DIE,DIC W !
EDN S DIC="^ORD(100.02,",DIC(0)="AEQM",DIC("A")="Select NATURE OF ORDER: "
S DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
D ^DIC Q:Y<1
S DA=+Y,DIE=DIC,DR=".12;.13;.15;.16" D ^DIE
W ! G EDN
Q
;
EDITOVR ; -- Edit Override Reason
N X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,NATIONAL W !
EOVR1 S DIC=100.04,DIC(0)="AELNQ",DIC("A")="Select OVERRIDE REASON: ",DLAYGO=100.04,DIC("DR")=".01"
D ^DIC Q:Y'>0
S NATIONAL=+$P($G(^ORD(100.04,+Y,0)),U,5)
S DA=+Y
I 'NATIONAL D
. S DIE=DIC,DIDEL=100.04,DR=".01;.02;.03;.04;.05///0" D ^DIE
I NATIONAL D
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. S DIR(0)="YA"
. S DIR("A")="Do you want to view the contents of the Override Reason? "
. S DIR("A",1)=""
. S DIR("A",2)=" *************************************************"
. S DIR("A",3)=" * You have selected a National Override Reason. *"
. S DIR("A",4)=" * You CANNOT edit this entry. *"
. S DIR("A",5)=" *************************************************"
. S DIR("A",6)=""
. S DIR("B")="NO"
. D ^DIR
. I Y=1 D
.. N DIQ
.. S DIQ(0)="R"
.. W !
.. D EN^DIQ
W ! G EOVR1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORX1 7488 printed Dec 13, 2024@02:37:52 Page 2
ORX1 ; SLC/DCM - OE/RR Nature of Order entry points ;Apr 24, 2024@07:20:01
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242,535**;Dec 17, 1997;Build 20
+2 ;Reference to ^DIC(9.4,"C" in ICR #2058
+3 ;Reference to ^DIC in ICR #10006
+4 ;Reference to MIX^DIC1 in ICR #10007
+5 ;Reference to ^DIE in ICR #10018
+6 ;Reference to ^DIR in ICR #10026
+7 ;
NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order
+1 ;DEFAULT [not required] =Free text code or pointer to Nature of order (file 100.02).
+2 ; Used for default response.
+3 ;REQUIRD [not required] =1 to require a response from user,
+4 ; =0 (default) not to require response.
+5 ;FB [not required] =F for frontdoor,
+6 ; =B (default) for backdoor.
+7 ; Screens on Frontdoor/Backdoor types.
+8 ; Nature of order entries are setup to be available for
+9 ; frontdoor or backdoor processing.
+10 ;DIRA [not required] =prompt for DIR("A")
+11 ; default:"Reason for Order/Change"
+12 ;DC [not required] =1 if you want to include 'DC only' types,
+13 ; =0 (default) includes all other types except for 'DC only'.
+14 ;LIST [not required] =List of 'Nature of Order' codes (from file 100.02)
+15 ; allowed. If this is passed, then DC and FB params
+16 ; are ignored. Format: code1code2code3
+17 ;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS")
+18 ;Returned value: ifn^name^code
+19 NEW DIR,X,Y,DIRUT,DUOUT
+20 SET DIR("?",1)="This order/change will be recorded in the patient's electronic record."
+21 SET DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the"
+22 SET DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
+23 SET DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
+24 SET DIR("?",5)=""
+25 SET DIR("?",6)=" Enter '??' for more information."
+26 SET DIR("?")=" "
+27 SET DIR("A")=$SELECT($LENGTH($GET(DIRA)):DIRA,1:"Reason for Order/Change")
+28 IF '$GET(DEFAULT)
IF $LENGTH($GET(DEFAULT))
IF $ORDER(^ORD(100.02,"C",DEFAULT,0))
SET DEFAULT=$ORDER(^(0))
+29 IF $GET(DEFAULT)
SET DIR("B")=$SELECT($DATA(^ORD(100.02,+DEFAULT,0)):$SELECT('$LENGTH($GET(LIST)):$PIECE(^(0),"^"),1:$SELECT($LENGTH($GET(LIST))&($GET(LIST)[$PIECE(^(0),"^",2)):$PIECE(^(0),"^"),1:""),1:""),1:"")
if DIR("B")=""
KILL DIR("B")
+30 SET DIR(0)="P^100.02:EMZ"
+31 if '$DATA(FB)
SET FB="B"
if FB=""
SET FB="B"
if '$DATA(DC)
SET DC=0
+32 IF $LENGTH($GET(LIST))
SET DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0),""^"",2)"
+33 IF '$LENGTH($GET(LIST))
SET DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),('$P(^(0),""^"",6)!(DC)),"_$SELECT(FB="B":"""XB""[$P(^(0),""^"",5)",FB="F":"""XF""[$P(^(0),""^"",5)",1:0)
+34 ;inactive VUID
SET DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")"
+35 SET DIR("??")="^D NA1^ORX1(DIR(""S""))"
OT2 DO ^DIR
+1 IF 'Y
IF $GET(REQUIRD)=1
WRITE !,"A "_$SELECT($LENGTH($GET(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$CHAR(7),!
GOTO OT2
+2 IF Y
SET $PIECE(Y,"^",3)=$PIECE(^ORD(100.02,+Y,0),"^",2)
+3 QUIT Y
NA1(SCREEN) ;Executable help for Nature of order
+1 ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
+2 NEW X,X1,Y
+3 WRITE !?30," Require",?43," Print",?56,"Print on"
+4 WRITE !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
+5 WRITE !?2,"------------------------",?29,"-----------",?43,"----------",?56,"--------"
+6 SET Y=0
FOR
SET Y=$ORDER(^ORD(100.02,Y))
if Y<1
QUIT
IF $DATA(^(Y,0))
if $DATA(SCREEN)
XECUTE SCREEN
IF $TEST
SET X=^ORD(100.02,Y,0)
SET X1=$GET(^(1))
WRITE !,?2,$PIECE(X,"^"),?34,$SELECT($PIECE(X1,"^",4)=2:"x",1:""),?47,$SELECT($PIECE(X1,"^",2):"x",1:""),?59,$SELECT($PIECE(X1,"^",3):"x",1:"")
+7 QUIT
NA2(SCREEN) ;Get help for DC Reasons
+1 ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
+2 NEW X,X1,I
+3 WRITE !?30," Require",?43," Print",?56,"Print on"
+4 WRITE !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
+5 WRITE !,"------------",?29,"-----------",?43,"----------",?56,"--------"
+6 SET I=0
FOR
SET I=$ORDER(^ORD(100.03,I))
if I<1
QUIT
IF $DATA(^(I,0))
if $DATA(SCREEN)
XECUTE SCREEN
IF $TEST
SET X=^(0)
IF $PIECE(X,"^",7)
IF $DATA(^ORD(100.02,$PIECE(X,"^",7),0))
WRITE !,$PIECE(X,"^")
SET X=^(0)
SET X1=$GET(^(1))
Begin DoDot:1
+7 WRITE ?34,$SELECT($PIECE(X1,"^",4)=2:"x",1:""),?47,$SELECT($PIECE(X1,"^",2):"x",1:""),?59,$SELECT($PIECE(X1,"^",3):"x",1:"")
End DoDot:1
+8 QUIT
+9 ;
CREATE(X) ; -- Returns 1 or 0, if action should be created or not
+1 NEW Y
if '$LENGTH($GET(X))
QUIT 0
+2 IF 'X
SET X=+$ORDER(^ORD(100.02,"C",X,0))
+3 SET Y=+$PIECE($GET(^ORD(100.02,+X,1)),U)
+4 QUIT Y
+5 ;
SIGSTS(X) ; -- Returns default signature status for nature X
+1 NEW Y
SET Y=""
if '$LENGTH($GET(X))
GOTO SIGQ
+2 IF 'X
SET X=+$ORDER(^ORD(100.02,"C",X,0))
if 'X
GOTO SIGQ
+3 SET Y=$PIECE($GET(^ORD(100.02,+X,1)),U,4)
SIGQ QUIT Y
+1 ;
CHART(X) ; -- Returns 1 or 0, print chart copy for nature X
+1 NEW Y
SET Y=""
if '$LENGTH($GET(X))
GOTO CHQ
+2 IF 'X
SET X=+$ORDER(^ORD(100.02,"C",X,0))
if 'X
GOTO CHQ
+3 SET Y=$PIECE($GET(^ORD(100.02,+X,1)),U,2)
CHQ QUIT Y
+1 ;
ACTV(X) ; -- Returns 1 or 0, include action in Active Orders
+1 NEW Y
SET Y=""
if '$LENGTH($GET(X))
GOTO ACTQ
+2 IF 'X
SET X=+$ORDER(^ORD(100.02,"C",X,0))
if 'X
GOTO ACTQ
+3 SET Y=$PIECE($GET(^ORD(100.02,+X,1)),U,6)
ACTQ QUIT Y
+1 ;
DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason
+1 ;DEFAULT=ifn of default reason
+2 ;REQ=1 to require a response
+3 ;PKG=ptr to file 9.4 to only get reasons for a specific package
+4 ;DIRA=Default prompt to be used instead of DIR("A")
+5 NEW DIR,X,Y,DIRUT,DUOUT
+6 SET DIR("?",1)="This order/change will be recorded in the patient's electronic record."
+7 SET DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the"
+8 SET DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
+9 SET DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
+10 SET DIR("?",5)=""
+11 SET DIR("?")=" "
+12 SET DIR("A")="Reason"
IF $LENGTH($GET(DIRA))
SET DIR("A")=DIRA
+13 IF $GET(DEFAULT)
SET DIR("B")=$SELECT($GET(DEFAULT):$SELECT($DATA(^ORD(100.03,+DEFAULT,0)):$PIECE(^(0),"^"),1:""),1:"")
+14 SET DIR(0)="P^100.03:EMZ"
+15 SET DIR("S")="I '$P(^(0),""^"",4)"_$SELECT($GET(PKG):",$P(^(0),""^"",5)=PKG",1:"")
+16 SET DIR("??")="^D NA2^ORX1(DIR(""S""))"
OT1 DO ^DIR
+1 IF 'Y
IF $GET(REQ)=1
WRITE !,"A REASON FOR DC must be entered",$CHAR(7),!
GOTO OT1
+2 QUIT $SELECT(Y:+Y_"^"_$GET(Y(0)),1:Y)
+3 ;
EDITDCR ; -- Edit DC Reason
+1 NEW X,Y,D,DIC,DIE,DR,DA,DLAYGO
WRITE !
EDC1 SET DIC=100.03
SET DIC(0)="AELNQM"
SET DIC("A")="Select DC REASON: "
SET DLAYGO=100.03
+1 SET DIC("S")="I $P(^(0),U,5)="_+$ORDER(^DIC(9.4,"C","OR",0))
SET D="B^S"
+2 SET DIC("DR")=".05////"_+$ORDER(^DIC(9.4,"C","OR",0))
DO MIX^DIC1
if Y'>0
QUIT
+3 SET DA=+Y
SET DIE=DIC
SET DR=".01;.03;.04;.07"
DO ^DIE
+4 WRITE !
GOTO EDC1
+5 QUIT
+6 ;
EDITNAT ; -- Edit allowable Nature of Order fields
+1 NEW X,Y,DA,DR,DIE,DIC
WRITE !
EDN SET DIC="^ORD(100.02,"
SET DIC(0)="AEQM"
SET DIC("A")="Select NATURE OF ORDER: "
+1 ;inactive VUID
SET DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")"
+2 DO ^DIC
if Y<1
QUIT
+3 SET DA=+Y
SET DIE=DIC
SET DR=".12;.13;.15;.16"
DO ^DIE
+4 WRITE !
GOTO EDN
+5 QUIT
+6 ;
EDITOVR ; -- Edit Override Reason
+1 NEW X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,NATIONAL
WRITE !
EOVR1 SET DIC=100.04
SET DIC(0)="AELNQ"
SET DIC("A")="Select OVERRIDE REASON: "
SET DLAYGO=100.04
SET DIC("DR")=".01"
+1 DO ^DIC
if Y'>0
QUIT
+2 SET NATIONAL=+$PIECE($GET(^ORD(100.04,+Y,0)),U,5)
+3 SET DA=+Y
+4 IF 'NATIONAL
Begin DoDot:1
+5 SET DIE=DIC
SET DIDEL=100.04
SET DR=".01;.02;.03;.04;.05///0"
DO ^DIE
End DoDot:1
+6 IF NATIONAL
Begin DoDot:1
+7 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 SET DIR(0)="YA"
+9 SET DIR("A")="Do you want to view the contents of the Override Reason? "
+10 SET DIR("A",1)=""
+11 SET DIR("A",2)=" *************************************************"
+12 SET DIR("A",3)=" * You have selected a National Override Reason. *"
+13 SET DIR("A",4)=" * You CANNOT edit this entry. *"
+14 SET DIR("A",5)=" *************************************************"
+15 SET DIR("A",6)=""
+16 SET DIR("B")="NO"
+17 DO ^DIR
+18 IF Y=1
Begin DoDot:2
+19 NEW DIQ
+20 SET DIQ(0)="R"
+21 WRITE !
+22 DO EN^DIQ
End DoDot:2
End DoDot:1
+23 WRITE !
GOTO EOVR1
+24 QUIT
