Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD1.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD1.m
r628 r636 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 ; 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 16 3 ;*Billing Awareness Project: 17 4 ; RABWDX Array: ICD Diagnosis^SC^AO^IR^EC^MST^HNC … … 21 8 S RAPKG="" N RAPTLKUP,RAGMTS,RACOPYOR 22 9 G ADDORD:$D(RAVSTFLG)&($D(RALIFN))&($D(RAPIFN)) 23 ;24 10 I '$D(RAREGFLG),'$D(RAVSTFLG) N RAPTLOCK K RAWARD D G:'RAPTLKUP Q 25 11 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 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 28 16 .S (DFN,RADFN)=+Y,(VA200,RAPTLKUP)=1 29 17 .W ! D IN5^VADPT S:VAIP(1) RAWARD=$P(VAIP(5),"^",2) 30 18 .D ELIG^RABWORD2 31 19 .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 ; 20 PL S DIC("A")="Patient Location: ",DIC("B")=$S($D(RAWARD):RAWARD,1:""),DIC="^SC(",DIC(0)="AEMQ",DIC("S")="I $$SCREEN^RAORD1A()" 48 21 D ^DIC K DIC K:'$D(RAREGFLG) RAWARD G Q:Y<0 S RALIFN=+Y 49 22 S DIC("A")="Person Requesting Order: " … … 66 39 S RADIV=$S($D(^RA(79,RADIV,0)):RADIV,1:$O(^RA(79,0))) 67 40 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" 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) 73 47 .Q 48 K:$D(RAWARD)&($E(RACAT,1)="O") RAWARD 49 K RASTRNG 74 50 ; clear clin hist if: 75 51 ; rad backdoor, or
Note:
See TracChangeset
for help on using the changeset viewer.