ORX1 ; slc/dcm - OE/RR Nature of Order entry points ;12/26/96 09:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242**;Dec 17, 1997;Build 6
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORX1 6352 printed Apr 09, 2024@21:36:09 Page 2
ORX1 ; slc/dcm - OE/RR Nature of Order entry points ;12/26/96 09:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242**;Dec 17, 1997;Build 6
+2 ;
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
