1 | RAORD1 ;HISC/CAH - AISC/RMO-Request An Exam ; 01/21/05 11:25am
|
---|
2 | ;;5.0;Radiology/Nuclear Medicine;**10,45,41,75**;Mar 16, 1998;Build 4
|
---|
3 | ;*Billing Awareness Project:
|
---|
4 | ; RABWDX Array: ICD Diagnosis^SC^AO^IR^EC^MST^HNC
|
---|
5 | ; RABWDX is used in RABWORD* and RABWPCE*.
|
---|
6 | K RABWDX
|
---|
7 | ;*
|
---|
8 | S RAPKG="" N RAPTLKUP,RAGMTS,RACOPYOR
|
---|
9 | G ADDORD:$D(RAVSTFLG)&($D(RALIFN))&($D(RAPIFN))
|
---|
10 | I '$D(RAREGFLG),'$D(RAVSTFLG) N RAPTLOCK K RAWARD D G:'RAPTLKUP Q
|
---|
11 | PAT .S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC
|
---|
12 | .I Y<0 S RAPTLKUP=0 Q
|
---|
13 | .I $$ORVR^RAORDU()'<3 D G:'RAPTLOCK PAT
|
---|
14 | ..S RAPTLOCK=$$LK^RAUTL19(+Y_";DPT(")
|
---|
15 | ..Q
|
---|
16 | .S (DFN,RADFN)=+Y,(VA200,RAPTLKUP)=1
|
---|
17 | .W ! D IN5^VADPT S:VAIP(1) RAWARD=$P(VAIP(5),"^",2)
|
---|
18 | .D ELIG^RABWORD2
|
---|
19 | .Q
|
---|
20 | PL S DIC("A")="Patient Location: ",DIC("B")=$S($D(RAWARD):RAWARD,1:""),DIC="^SC(",DIC(0)="AEMQ",DIC("S")="I $$SCREEN^RAORD1A()"
|
---|
21 | D ^DIC K DIC K:'$D(RAREGFLG) RAWARD G Q:Y<0 S RALIFN=+Y
|
---|
22 | S DIC("A")="Person Requesting Order: "
|
---|
23 | ;*Billing Awareness Project:
|
---|
24 | S DIC("S")="I $$PROV^RABWORD()"
|
---|
25 | ;Display Service Connected prompts if user is a Provider.
|
---|
26 | S DIC="^VA(200,",DIC(0)="AEMQ",Y=DUZ S:$$PROV^RABWORD DIC("B")=$P(^VA(200,DUZ,0),"^",1)
|
---|
27 | D ^DIC K DIC G Q:Y<0 S RAPIFN=+Y K DD,DO,VA200,VAERR,VAIP G ADDORD:$D(RAVSTFLG)
|
---|
28 | ;
|
---|
29 | ENADD ;OE/RR Entry Point for the ACTION Option
|
---|
30 | K ORSTOP,ORTO,ORCOST,ORPURG
|
---|
31 | I '$D(RAPKG) G Q:'$D(ORVP)!('$D(ORL))!('$D(ORNP)) S (DFN,RADFN)=+ORVP,RALIFN=+ORL,RAPIFN=$S(+ORNP:+ORNP,$D(RAPIFN):RAPIFN,1:+ORNP),RAFOERR=""
|
---|
32 | ; RAFOERR is used as a flag to track when a user enters this option
|
---|
33 | ; from OE/RR (frontdoor). If this variable exists when a request is
|
---|
34 | ; being printed, exam information is omitted from the request.
|
---|
35 | S RANME=^DPT(RADFN,0),RASEX=$P(RANME,"^",2),RANME=$P(RANME,"^") D EXAM^RADEM1:'$D(RAREGFLG)&($D(RAPKG)) I '$D(RAREGFLG) S VA200=1 D IN5^VADPT S:VAIP(1) RAWARD=$P(VAIP(5),"^",2)
|
---|
36 | D SAVE ; save off original value of RAMDV!
|
---|
37 | S RAL0=$S($D(^SC(RALIFN,0)):^(0),1:0)
|
---|
38 | S RADIV=+$$SITE^VASITE(DT,+$P(RAL0,"^",15)) S:RADIV<0 RADIV=0
|
---|
39 | S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0)))
|
---|
40 | S RAMDV=$TR($G(^RA(79,+RADIV,.1)),"YyNn","1100")
|
---|
41 | S RACAT=$S($D(RACAT):RACAT,$D(RAWARD):"INPATIENT",$P(RAL0,"^",2)="PERSONNEL HEALTH":"EMPLOYEE",'$D(^RADPT(RADFN,0)):"OUTPATIENT",$P(^(0),"^",4)]"":$P($P(^DD(70,.04,0),$P(^RADPT(RADFN,0),"^",4)_":",2),";"),1:"OUTPATIENT")
|
---|
42 | I "IO"[$E(RACAT,1) D
|
---|
43 | .S RASTRNG=$$MATCH^RAORD1A(RACAT,RALIFN)
|
---|
44 | .;if necessary, change category of exam to match type of requesting
|
---|
45 | .;location and display msg to user
|
---|
46 | .S RACAT=$P(RASTRNG,"^"),RAWARD=$P(RASTRNG,"^",2)
|
---|
47 | .Q
|
---|
48 | K:$D(RAWARD)&($E(RACAT,1)="O") RAWARD
|
---|
49 | K RASTRNG
|
---|
50 | ; clear clin hist if:
|
---|
51 | ; rad backdoor, or
|
---|
52 | ; oe/rr's first order (quick or not)
|
---|
53 | I $D(RAPKG) K ^TMP($J,"RAWP")
|
---|
54 | I '$D(RAPKG),$G(XQORS)>1,$G(^TMP("XQORS",$J,XQORS-1,"ITM"))=1 K ^TMP($J,"RAWP")
|
---|
55 | ;
|
---|
56 | ADDORD I $D(RADR1) D ALLERGY,CREATE1 G Q
|
---|
57 | ; Set flag variable 'RASTOP' to track if procedure messages (if any)
|
---|
58 | ; have been displayed. Value altered in EN2+1^RAPRI & DISP+12^RAORDU1.
|
---|
59 | D:'$D(VAEL) ELIG^VADPT
|
---|
60 | I $D(^RAO(75.1,"B",RADFN)) D
|
---|
61 | .I '$D(RAVSTFLG) D PREV^RABWORD2 Q
|
---|
62 | .D ADDEXAM^RABWORD2
|
---|
63 | D DISP^RAPRI G:RAIMGTYI'>0 Q
|
---|
64 | ADDORD1 W !,"Select Procedure",$S(RACNT:" (1-"_RACNT_") ",1:" "),"or enter '?' for help: "
|
---|
65 | R RARX:DTIME
|
---|
66 | S:'$T RARX="^" G Q:RARX=""!($E(RARX)="^")
|
---|
67 | S:RARX=" " RARX=$S($D(RASX):RASX,1:RARX)
|
---|
68 | I $E(RARX)="?"!(RARX=0)!(RARX=" ")!(RARX?.E1N1"-"1N.E)!(RARX?.E1".".E) D HELP^RAPRI G Q:Y'=1 D DISP1^RAPRI G ADDORD1
|
---|
69 | S RAEXMUL=1 K RAHSMULT
|
---|
70 | F RAJ=1:1 S X=$P(RARX,",",RAJ) Q:X="" S RASTOP=0 W !!!,"Processing procedure: ",$S(+X&(+X'>RACNT):$P($G(RAPRC(X)),"^"),$E(X)'="`":X,1:"") D LOOKUP^RAPRI Q:$D(RAOUT) S:RAPRI>0 RASX="`"_RAPRI D:RAPRI>0 ALLERGY,CREATE Q:$D(RAOUT) K RAPRI
|
---|
71 | I $D(RAREASK),'$D(RAOUT) K RAREASK D DISP1^RAPRI G ADDORD1
|
---|
72 | Q ; Kill, unlock if locked, and quit
|
---|
73 | D KILL^RAORD
|
---|
74 | D SAVE ; reset RAMDV to its original value!
|
---|
75 | I $$ORVR^RAORDU()'<3,(+$G(RAPTLOCK)),(+$G(RADFN)) D
|
---|
76 | . D ULK^RAUTL19(RADFN_";DPT(")
|
---|
77 | K:'$D(RAREGFLG)&('$D(RAVSTFLG)) RACAT,RADFN,RANME,RAWARD
|
---|
78 | I '$D(RAPKG) K RAMDIV,RAMDV,RAMLC
|
---|
79 | I $D(RAPKG) K ORIFN,ORIT,ORL,ORNP,ORNS,ORPCL,ORPK,ORPV,ORPURG,ORSTS,ORTX,ORVP,RAPKG
|
---|
80 | K RAHSMULT,RAPOP,RAIMAG,RAREAST,RAREQLOC
|
---|
81 | K C,DI,DIG,DIH,DISYS,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DN,I,ORCHART,POP,RAMDVZZ,RASCI,RASERIES
|
---|
82 | Q
|
---|
83 | CREATE S RACT=0 D MODS Q:$D(RAOUT)
|
---|
84 | CREATE1 ;ask for the 'Date Desired' req'd P75
|
---|
85 | S RAWHEN=$$DESDT^RAUTL12(RAPRI) S:RAWHEN=-1 RAOUT=1 Q:$D(RAOUT)#2
|
---|
86 | S RAWHEN=$$FMTE^XLFDT(RAWHEN,1) ;convert to external format
|
---|
87 | ; Ask pregnant if age is between 12 & 55. Ask once for mult requests
|
---|
88 | ; RASKPREG is the variable used to track if the pregnant prompt has
|
---|
89 | ; been asked. Ask only once for multiple requests.
|
---|
90 | S:'$D(RASKPREG) RAPREG=$$PREG^RAORD1A(RADFN,$G(DT)),RASKPREG="" Q:$D(RAOUT)
|
---|
91 | ;Reason for Study (req'd) & Clinical History (optional) asked in CH^RAUTL5 P75
|
---|
92 | D CH^RAUTL5 Q:$D(RAOUT) ;RAOUT: defined if Reason for Study is nonexistent
|
---|
93 | BAQUES ;*Billing Awareness Project
|
---|
94 | ; Ask Ordering ICD-9 Diagnosis and Related SC/EI/MST/HNC questions.
|
---|
95 | N RADTM D NOW^%DTC S RADTM=%
|
---|
96 | D ASK^RABWORD(RADFN,RADTM)
|
---|
97 | I '$D(RADR1) D DISP^RAORDU1 Q:$D(RAOUT) ; Display Order Responses.
|
---|
98 | S X=RADFN,DIC="^RAO(75.1,",DIC(0)="L",DLAYGO=75.1
|
---|
99 | D FILE^DICN K DIC Q:Y<0 S RAOIFN=+Y K DLAYGO
|
---|
100 | I $D(RAREGFLG)!($D(RAVSTFLG)) S RANUM=$S('$D(RANUM):1,1:RANUM+1),RAORDS(RANUM)=RAOIFN
|
---|
101 | I $D(^RA(79,+RADIV,.1)),$P(^(.1),"^",21)="y" S RALOCFLG=""
|
---|
102 | W ! S DA=RAOIFN,DIE="^RAO(75.1,",DIE("NO^")="OUTOK"
|
---|
103 | S DR=$S($D(RADR1):"[RA QUICK EXAM ORDER]",$D(RADR2):"[RA ORDER EXAM]",$D(RAEXMUL)&($D(RAFIN1)):"[RA QUICK EXAM ORDER]",1:"[RA ORDER EXAM]")
|
---|
104 | ;*Billing Awareness Project
|
---|
105 | ; If Order questions are being Re-Asked then Re-Ask ICD-9 Dx questions
|
---|
106 | I DR="[RA ORDER EXAM]" D ASK^RABWORD(RADFN,RADTM) W !!
|
---|
107 | D ^DIE
|
---|
108 | K DIE("NO^"),DE,DQ,DIE,DR,RADR1,RADR2
|
---|
109 | I $D(RAFIN),$D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0) D FILEDX^RABWORD(RADFN,RAOIFN) Q:'$D(RAFIN) D SETORD^RAORDU D OERR^RAORDU:'$D(RAPKG) D ^RAORDQ:$D(RAPKG) K RAORD0
|
---|
110 | I '$D(RAFIN) W !?3,$C(7),"Request not complete. Must Delete..." S DA=RAOIFN,DIK="^RAO(75.1," D ^DIK W "...deletion complete!" I $D(RAREGFLG)!($D(RAVSTFLG)) K RAORDS(RANUM)
|
---|
111 | I '$D(RAFIN),('$D(^RAO(75.1,RAOIFN,0))#2) Q ; record deleted!
|
---|
112 | K RAFIN
|
---|
113 | ; check if the 'stat' or 'urgent' alert is to be sent.
|
---|
114 | N RALOC,RAORD0
|
---|
115 | S RAORD0=$G(^RAO(75.1,RAOIFN,0)),RALOC=+$P(RAORD0,"^",20)
|
---|
116 | Q:'RALOC ; if no 'SUBMIT TO' location, can't send stat/urgent alerts
|
---|
117 | I $P(RAORD0,"^",6)=1!(($P(RAORD0,"^",6)=2)&($P(^RA(79.1,RALOC,0),"^",20)="Y")) D
|
---|
118 | .; If 6th piece of RAORD0=1 *stat*, =2 *urgent*
|
---|
119 | .Q:$$ORVR^RAORDU()<3
|
---|
120 | .; needs OE/RR 3.0 or greater for stat/urgent alerts to fire
|
---|
121 | .D OENO^RAUTL19(RAOIFN)
|
---|
122 | .Q
|
---|
123 | Q
|
---|
124 | ;
|
---|
125 | MODS ;RAPRI= Procedure IEN, RAIMAG=Imaging Type for the procedure.
|
---|
126 | ;Edited 4/19/94, Type of Imaging is now a multiple in file 71.2. CEW
|
---|
127 | S RAIMAG=+$$ITYPE^RASITE(RAPRI),DIC(0)="AEQMZ",DIC="^RAMIS(71.2,",DIC("A")="Select "_$P($G(^DIC(71.2,0)),"^")_": "
|
---|
128 | S DIC("S")="I +$D(^RAMIS(71.2,""AB"",RAIMAG,+Y)),$S('$G(RASERIES):1,$P(^RAMIS(71.2,+Y,0),U,2)="""":1,1:0),$$INIMOD^RAORD1A($P($G(^RAMIS(71.2,+Y,0)),""^""))"
|
---|
129 | D ^DIC K DIC,RAIMAG S:$D(DTOUT)!($D(DUOUT)) RAOUT=1 Q:$D(RAOUT)!(X="^")!(X="") I Y<1 W $C(7)," ??" G MODS
|
---|
130 | S RACT=RACT+1,RAMOD(RACT)=$P(Y,"^",2) G MODS
|
---|
131 | Q
|
---|
132 | ;
|
---|
133 | ALLERGY ; If patient has had a previous contrast media allergic reaction
|
---|
134 | ; check procedure RAPRI for specific contrast media associations
|
---|
135 | ; (new with RA*5*45)
|
---|
136 | Q:'$$ORCHK^GMRAOR(RADFN,"CM")
|
---|
137 | S RAPRI(0)=$G(^RAMIS(71,RAPRI,0))
|
---|
138 | I $P(RAPRI(0),U,6)'="P" D ;not a parent check lone procedure
|
---|
139 | .D CONTRAST^RAUTL2(RAPRI)
|
---|
140 | .Q
|
---|
141 | E S I=0 D ;check descendent procedures for CM
|
---|
142 | .F S I=$O(^RAMIS(71,RAPRI,4,I)) Q:'I D CONTRAST^RAUTL2(+$G(^(I,0)))
|
---|
143 | .K I
|
---|
144 | .Q
|
---|
145 | K RAPRI(0)
|
---|
146 | Q
|
---|
147 | SAVE ; Save original value of RAMDV before it is altered in the ENADD sub-
|
---|
148 | ; routine. This code will also reset RAMDV to the sign-on value.
|
---|
149 | Q:'$D(RAPKG) ; entered through OE/RR (RAMDV will not be set)
|
---|
150 | Q:'$D(RAMDV)&('$D(RAMDVZZ)) ;entered through 'Request an Exam' option used stand-alone outside of Rad/NM pkg
|
---|
151 | I '$D(RAMDVZZ) S RAMDVZZ=RAMDV
|
---|
152 | E S RAMDV=RAMDVZZ
|
---|
153 | Q
|
---|