source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDGMRC.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1ORCDGMRC ;SLC/MKB-Utility functions for GMRC dialogs ;3/10/03 07:34
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,68,100,181**;Dec 17, 1997
3 ; External References
4 ; DBIA 10006 Call to ^DIC
5 ; DBIA 10026 Call to ^DIR
6 ; DBIA 2426 Call to SERV1^GMRCASV
7 ; DBIA 3119 Call to GETDEF^GMRCDRFR
8 ; DBIA 2982 Call to GETSVC^GMRCPR0
9 ; DBIA 3121 Call to APIs $$PROVDX and PREREQ in routine ^GMRCUTL1
10 ; DBIA 1609 Call to CONFIG^LEXSET
11 ; DBIA 10104 Call to APIs $$RJ and $$UP in routine ^XLFSTR
12 ; DBIA 10102 Call to DISP^XQORM1
13 ; DBIA 3991 Call to $$STATCHK^ICDAPIU
14URGENCY(TYPE) ; -- Returns index of allowable urgencies from file #101.42
15 N X S X=$S($$VAL^ORCD("CATEGORY")'="I":"O",TYPE="C":"T",1:"R")
16 S ORDIALOG(PROMPT,"D")="S.GMRC"_X
17 Q
18 ;
19PLACE ; -- Returns list of allowable places of consultation
20 Q:$D(ORDIALOG(PROMPT,"LIST")) N CHOICES,I,J,INPT,X
21 S INPT=($$VAL^ORCD("CATEGORY")="I")
22 I INPT S CHOICES="B^Bedside;C^Consultant's Choice"
23 I 'INPT S CHOICES="E^Emergency Room;C^Consultant's Choice"
24 S I=0 F J=1:1:$L(CHOICES,";") S X=$P(CHOICES,";",J) D
25 . S I=I+1,ORDIALOG(PROMPT,"LIST",I)=X
26 . S ORDIALOG(PROMPT,"LIST","B",$$UP^XLFSTR($P(X,U,2)))=$P(X,U)
27 S ORDIALOG(PROMPT,"LIST")=I_"^1"
28 Q
29 ;
30CHANGED(PRMT) ; -- Kill lists for Request Service or Place of Consultation
31 N I,P
32 S I=$S(PRMT="OI":"REQUEST SERVICE",1:"PLACE OF CONSULTATION")
33 S P=$$PTR^ORCD("OR GTX "_I) Q:'P
34 K ORDIALOG(P,"LIST"),ORDIALOG(P,1)
35 Q
36 ;
37GETSERV ; -- Get list of orderable services
38 N GMRCTO,GMRCDG,I,X K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
39 S (GMRCTO,GMRCDG)=1 D SERV1^GMRCASV ; get list of orderable services
40 F I=1:1 S X=+$G(^TMP("GMRCSLIST",$J,I)) Q:X'>0 S $P(^TMP("GMRCS",$J,X),U,2)=I
41 Q
42 ;
43LISTSERV(ORI) ; -- List Consult services from ORSERV
44 N ORSTK,ORCNT,ORX,ORQ
45 W !,"Choose from:" S:$G(ORI)'>0 ORI=1
46 S (ORSTK,ORQ)=0,ORCNT=1,ORSTK(0)=$P(^TMP("GMRCSLIST",$J,ORI),U,3)
47 F S ORX=$G(^TMP("GMRCSLIST",$J,ORI)) Q:ORX="" D Q:ORQ S ORI=ORI+1
48 . I $P(ORX,U,3)'=+$G(ORSTK(ORSTK)) D POP I ORSTK'>0 S ORQ=1 Q
49 . S ORCNT=ORCNT+1 I ORCNT>(IOSL-6) S:'$$CONT ORQ=1 Q:$G(ORQ) S ORCNT=1
50 . W !,?((ORSTK*2)),$P(ORX,U,2)
51 . W:$P(ORX,U,5) " ("_$S($P(ORX,U,5)=1:"Grouper",1:"Tracking")_" Only)"
52 . I $P(ORX,U,4)="+" S ORSTK=ORSTK+1,ORSTK(ORSTK)=+ORX
53 Q
54 ;
55POP ; -- pop stack
56 S ORSTK=ORSTK-1 Q:ORSTK'>0
57 I ORSTK(ORSTK)'=$P(ORX,U,3) G POP
58 Q
59 ;
60CONT() ; -- continue?
61 N X,Y,DIR S DIR(0)="E" D ^DIR
62 Q +Y
63 ;
64CKSERV ; -- Ck service usage in Post-Selection Action
65 N GMRCI,ORI
66 S GMRCI=+$P(^ORD(101.43,+Y,0),U,2)
67 S ORI=+$P($G(^TMP("GMRCS",$J,GMRCI)),U,2) S:ORI'>0 ORI=1
68 I $P($G(^TMP("GMRCSLIST",$J,ORI)),U,5)=1 D LISTSERV^ORCDGMRC(ORI) K DONE
69 Q
70 ;
71PROCSVC ; -- Get list of services for procedure
72 Q:$D(ORDIALOG(PROMPT,"LIST")) Q:'$L($T(GETSVC^GMRCPR0))
73 N OI,PROTCL,ORY,ORI,X
74 S OI=+$$VAL^ORCD("PROCEDURE"),PROTCL=$P($G(^ORD(101.43,OI,0)),U,2) ;ID
75 D:PROTCL GETSVC^GMRCPR0(.ORY,PROTCL)
76 I $G(ORY)'>0 W $C(7),!,"There are no services defined for this procedure!" H 1 S ORQUIT=1 Q
77 M ORDIALOG(PROMPT,"LIST")=ORY S $P(ORDIALOG(PROMPT,"LIST"),U,2)=1
78 S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 S X=$P(ORY(ORI),U,2),ORDIALOG(PROMPT,"LIST","B",X)=+ORY(ORI)
79 Q
80 ;
81CKPROCSV ; -- Make sure procedure has at least one service
82 N PROT,ORY S PROT=$P($G(^ORD(101.43,+Y,0)),U,2)
83 D GETSVC^GMRCPR0(.ORY,PROT) I $G(ORY)'>0 W $C(7),!,"There are no services defined for this procedure!",! K DONE
84 Q
85 ;
86NWHELP ; -- help code for NW action
87 N X
88 W !!,"Select the type of request you wish to enter, either a consult to a service",!,"or a procedure that may be ordered without a formal consult."
89 W !!,"Press <return> to continue ..." R X:DTIME
90 S X="?" D DISP^XQORM1 W !
91 Q
92 ;
93REASON ; -- Get default Reason for Request text for Service
94 N ORIT,ORSERV,OROOT
95 S ORIT=$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
96 S ORSERV=$P($G(^ORD(101.43,+ORIT,0)),U,2) Q:'ORSERV!(ORSERV["99PRO")
97 S OROOT=$NA(^TMP("ORWORD",$J,PROMPT,INST)) D
98 . N PROMPT,INST,X,Y,DIR,ACTION,REQD,MULT,ITEM,COND ;protect var's
99 . D GETDEF^GMRCDRFR(OROOT,ORSERV,+$G(ORVP),$S($G(ORVP):1,1:0))
100 S:$D(^TMP("ORWORD",$J,PROMPT,INST)) Y=OROOT
101 Q
102 ;
103ENPDX ; -- setup Prov Dx field
104 N CODE
105 S ORPDX=$$PROVDX^GMRCUTL1($S($D(ORPROC):ORPROC,1:$G(ORSERV)))
106 S CODE=$$PTR^ORCD("OR GTX CODE")
107 I $P(ORPDX,U)="S" K ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST) S COND="I 0" Q
108 S:$G(ORTYPE)'="Z" REQD=$S($P(ORPDX,U)="R":1,1:0)
109 K:$P(ORPDX,U,2)'="L" ORDIALOG(CODE,INST)
110 I $P(ORPDX,U,2)="L" S ORDIALOG(PROMPT,"?")="Select a preliminary diagnosis from the Lexicon, as text or an ICD code." K:'$L($G(ORDIALOG(CODE,INST))) ORDIALOG(PROMPT,INST)
111 I $L($G(ORDIALOG(CODE,INST))),'$$STATCHK^ICDAPIU(ORDIALOG(CODE,INST),DT) D ;csv
112 . D EN^DDIOL("The existing diagnosis is associated with an inactive ICD-9 code.")
113 . I $G(REQD) D EN^DDIOL("Another code must be selected before proceeding.")
114 . I '$G(REQD) D EN^DDIOL("If another code is not selected, no code will be saved with the new order.")
115 . D EN^DDIOL(" ")
116 . K ORDIALOG(PROMPT,INST),ORDIALOG(CODE,INST)
117 . S ACTION=$G(ACTION)_"W"
118 Q
119 ;
120LEX ; -- search Lexicon for Prov Dx
121 I $L($G(ORESET)),ORESET=Y Q ;no change
122 I Y?1." " K DONE W !!,$C(7),"Use of only spaces not allowed!",! Q
123 Q:$P(ORPDX,U,2)'="L" ;free text only, no ICD code
124 N DIC,DUOUT,DTOUT
125 D CONFIG^LEXSET("ICD","ICD",DT)
126 S DIC="^LEX(757.01,",DIC(0)="EQM",DIC("A")="Provisional Diagnosis: "
127 S:$L($G(ORESET)) DIC("B")=ORESET
128 D ^DIC I Y'>0 D Q
129 . I $L($G(ORESET)) S ORDIALOG(PROMPT,ORI)=ORESET
130 . E K ORDIALOG(PROMPT,ORI)
131 . I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q
132 . I REQD,'$D(ORDIALOG(PROMPT,ORI)) K DONE W !!,$C(7),$$REQUIRED^ORCDLG1,!
133 S ORDIALOG(PROMPT,ORI)=$P(Y,U,2)
134 S ORDIALOG($$PTR^ORCD("OR GTX CODE"),ORI)=$G(Y(1)) K Y(1)
135 Q
136 ;
137SERVMSG ; -- Get, display text message for service ORSERV
138 Q:'$G(ORSERV)&('$G(ORPROC)) Q:'FIRST ;show first time only
139 N ORTXT,I,CNT,HDR S HDR=$S($G(ORMENU):5,1:7)
140 D PREREQ^GMRCUTL1("ORTXT",$S($D(ORPROC):ORPROC,1:ORSERV),+ORVP)
141 Q:'$D(ORTXT)
142 I $D(ORPROC) W !!,$$RJ^XLFSTR("** Procedure Pre-requisite **",57)
143 E W !!,$$RJ^XLFSTR("** Consult Service Pre-requisite **",57)
144 S (I,CNT)=0 F S I=$O(ORTXT(I)) Q:I'>0 D Q:$G(ORQUIT)
145 . S CNT=CNT+1 I CNT>(IOSL-HDR) S CNT=0 I '$$CONT S ORQUIT=1 Q
146 . W !,ORTXT(I,0)
147 Q:$G(ORQUIT) S:'$$CONT ORQUIT=1 W !
148 Q
Note: See TracBrowser for help on using the repository browser.