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