source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORX1.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1ORX1 ; slc/dcm - OE/RR Nature of Order entry points ;12/26/96 09:49
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**92,242**;Dec 17, 1997;Build 6
3 ;
4NA(DEFAULT,REQUIRD,FB,DIRA,DC,LIST) ;Function to get Nature of order
5 ;DEFAULT [not required] =Free text code or pointer to Nature of order (file 100.02).
6 ; Used for default response.
7 ;REQUIRD [not required] =1 to require a response from user,
8 ; =0 (default) not to require response.
9 ;FB [not required] =F for frontdoor,
10 ; =B (default) for backdoor.
11 ; Screens on Frontdoor/Backdoor types.
12 ; Nature of order entries are setup to be available for
13 ; frontdoor or backdoor processing.
14 ;DIRA [not required] =prompt for DIR("A")
15 ; default:"Reason for Order/Change"
16 ;DC [not required] =1 if you want to include 'DC only' types,
17 ; =0 (default) includes all other types except for 'DC only'.
18 ;LIST [not required] =List of 'Nature of Order' codes (from file 100.02)
19 ; allowed. If this is passed, then DC and FB params
20 ; are ignored. Format: code1code2code3
21 ;Example: S X=$$NA^ORX1(1,1,,,,"WVPIS")
22 ;Returned value: ifn^name^code
23 N DIR,X,Y,DIRUT,DUOUT
24 S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
25 S DIR("?",2)="Depending on the nature of this activity, a notification may be sent to the"
26 S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
27 S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
28 S DIR("?",5)=""
29 S DIR("?",6)=" Enter '??' for more information."
30 S DIR("?")=" "
31 S DIR("A")=$S($L($G(DIRA)):DIRA,1:"Reason for Order/Change")
32 I '$G(DEFAULT),$L($G(DEFAULT)),$O(^ORD(100.02,"C",DEFAULT,0)) S DEFAULT=$O(^(0))
33 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")
34 S DIR(0)="P^100.02:EMZ"
35 S:'$D(FB) FB="B" S:FB="" FB="B" S:'$D(DC) DC=0
36 I $L($G(LIST)) S DIR("S")="I '$P(^(0),""^"",4),'$P(^(0),""^"",3),LIST[$P(^(0),""^"",2)"
37 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)
38 S DIR("S")=DIR("S")_",'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
39 S DIR("??")="^D NA1^ORX1(DIR(""S""))"
40OT2 D ^DIR
41 I 'Y,$G(REQUIRD)=1 W !,"A "_$S($L($G(DIRA)):DIRA,1:"NATURE OF ORDER/CHANGE")_" must be entered",$C(7),! G OT2
42 I Y S $P(Y,"^",3)=$P(^ORD(100.02,+Y,0),"^",2)
43 Q Y
44NA1(SCREEN) ;Executable help for Nature of order
45 ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
46 N X,X1,Y
47 W !?30," Require",?43," Print",?56,"Print on"
48 W !?2,"Nature of Order Activity",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
49 W !?2,"------------------------",?29,"-----------",?43,"----------",?56,"--------"
50 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:"")
51 Q
52NA2(SCREEN) ;Get help for DC Reasons
53 ;SCREEN=Mumps code that is used like DIC("S") to screen out entries
54 N X,X1,I
55 W !?30," Require",?43," Print",?56,"Print on"
56 W !,"Order Reason",?29,"E.Signature",?43,"Chart Copy",?56,"Summary"
57 W !,"------------",?29,"-----------",?43,"----------",?56,"--------"
58 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
59 . W ?34,$S($P(X1,"^",4)=2:"x",1:""),?47,$S($P(X1,"^",2):"x",1:""),?59,$S($P(X1,"^",3):"x",1:"")
60 Q
61 ;
62CREATE(X) ; -- Returns 1 or 0, if action should be created or not
63 N Y Q:'$L($G(X)) 0
64 I 'X S X=+$O(^ORD(100.02,"C",X,0))
65 S Y=+$P($G(^ORD(100.02,+X,1)),U)
66 Q Y
67 ;
68SIGSTS(X) ; -- Returns default signature status for nature X
69 N Y S Y="" G:'$L($G(X)) SIGQ
70 I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X SIGQ
71 S Y=$P($G(^ORD(100.02,+X,1)),U,4)
72SIGQ Q Y
73 ;
74CHART(X) ; -- Returns 1 or 0, print chart copy for nature X
75 N Y S Y="" G:'$L($G(X)) CHQ
76 I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X CHQ
77 S Y=$P($G(^ORD(100.02,+X,1)),U,2)
78CHQ Q Y
79 ;
80ACTV(X) ; -- Returns 1 or 0, include action in Active Orders
81 N Y S Y="" G:'$L($G(X)) ACTQ
82 I 'X S X=+$O(^ORD(100.02,"C",X,0)) G:'X ACTQ
83 S Y=$P($G(^ORD(100.02,+X,1)),U,6)
84ACTQ Q Y
85 ;
86DC(DEFAULT,REQ,PKG,DIRA) ;Function to get a DC Reason
87 ;DEFAULT=ifn of default reason
88 ;REQ=1 to require a response
89 ;PKG=ptr to file 9.4 to only get reasons for a specific package
90 ;DIRA=Default prompt to be used instead of DIR("A")
91 N DIR,X,Y,DIRUT,DUOUT
92 S DIR("?",1)="This order/change will be recorded in the patient's electronic record."
93 S DIR("?",2)="Depending of the nature of this activity, a notification may be sent to the"
94 S DIR("?",3)="requesting clinician to electronically sign this action, and a copy of this"
95 S DIR("?",4)="action may be printed on the ward/clinic to be placed in the patient's chart."
96 S DIR("?",5)=""
97 S DIR("?")=" "
98 S DIR("A")="Reason" I $L($G(DIRA)) S DIR("A")=DIRA
99 I $G(DEFAULT) S DIR("B")=$S($G(DEFAULT):$S($D(^ORD(100.03,+DEFAULT,0)):$P(^(0),"^"),1:""),1:"")
100 S DIR(0)="P^100.03:EMZ"
101 S DIR("S")="I '$P(^(0),""^"",4)"_$S($G(PKG):",$P(^(0),""^"",5)=PKG",1:"")
102 S DIR("??")="^D NA2^ORX1(DIR(""S""))"
103OT1 D ^DIR
104 I 'Y,$G(REQ)=1 W !,"A REASON FOR DC must be entered",$C(7),! G OT1
105 Q $S(Y:+Y_"^"_$G(Y(0)),1:Y)
106 ;
107EDITDCR ; -- Edit DC Reason
108 N X,Y,D,DIC,DIE,DR,DA,DLAYGO W !
109EDC1 S DIC=100.03,DIC(0)="AELNQM",DIC("A")="Select DC REASON: ",DLAYGO=100.03
110 S DIC("S")="I $P(^(0),U,5)="_+$O(^DIC(9.4,"C","OR",0)),D="B^S"
111 S DIC("DR")=".05////"_+$O(^DIC(9.4,"C","OR",0)) D MIX^DIC1 Q:Y'>0
112 S DA=+Y,DIE=DIC,DR=".01;.03;.04;.07" D ^DIE
113 W ! G EDC1
114 Q
115 ;
116EDITNAT ; -- Edit allowable Nature of Order fields
117 N X,Y,DA,DR,DIE,DIC W !
118EDN S DIC="^ORD(100.02,",DIC(0)="AEQM",DIC("A")="Select NATURE OF ORDER: "
119 S DIC("S")="I '$P(^(0),""^"",4),'$$SCREEN^XTID(100.02,,Y_"","")" ;inactive VUID
120 D ^DIC Q:Y<1
121 S DA=+Y,DIE=DIC,DR=".12;.13;.15;.16" D ^DIE
122 W ! G EDN
123 Q
Note: See TracBrowser for help on using the repository browser.