source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORDC1.m@ 1432

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1RAORDC1 ;HISC/GJC-Continuation of the RAORDC routine. ;6/19/97 08:28
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4EXMCOM ; Called from EXMCOM^RAORDC, for updating request statuses for
5 ; complete exams.
6 K RAPRC,RACAT,RAPIFN,RARSH,RASHA,RAMIFN,RAMOD,RAMODA,RAMODD
7 N RAPRGST S RAPRGST=$P(RAORD0,"^",13)
8 I $P($G(RAEXM0),"^",25) D D SETU Q
9 . N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
10 . S DIE="^RAO(75.1,",DR="11///Y",DA=RAOIFN D ^DIE
11 . Q
12 S:$P(RAEXM0,"^",2)'=$P(RAORD0,"^",2) RAPRC=$P(RAEXM0,"^",2)
13 S:$P(RAEXM0,"^",4)'=$P(RAORD0,"^",4) RACAT=""""_$P(RAEXM0,"^",4)_""""
14 S RARSH=$S($P(RAORD0,"^",4)="R"&($P(RAEXM0,"^",4)'="R"):"@",$P(RAEXM0,"^",4)="R"&($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R"))):"^S X="_""""_^("R")_"""",1:"") K:RARSH="" RARSH
15 S RASHA=$S("CS"[$P(RAORD0,"^",4)&("CS"'[$P(RAEXM0,"^",4)):"@","CS"[$P(RAEXM0,"^",4)&($P(RAEXM0,"^",9)'=""):"^S X="_$P(RAEXM0,"^",9),1:"") K:RASHA="" RASHA
16 S:$P(RAEXM0,"^",14)'=$P(RAORD0,"^",14)&($P(RAEXM0,"^",14)) RAPIFN=$P(RAEXM0,"^",14)
17 ; don't del/add modifiers to order file
18 ; remove most fields from DR string to prevent chang'g them in the order
19 S DA=RAOIFN,DIE="^RAO(75.1,",DR="11////^S X=""n"""
20 D ^DIE K DE,DQ,DIE,DR
21 K RAMOD F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RAMOD=$S('$D(RAMOD):$P(^(0),"^"),1:RAMOD_", "_$P(^(0),"^"))
22SETU ; above code is skipped if procedure is parent
23 S $P(RABLNK," ",40)=""
24 I $$ORVR^RAORDU()=2.5,$D(^RAO(75.1,+RAOIFN,0)),$D(^RAMIS(71,+$P(^(0),"^",2),0)) S (RAPRC,ORETURN("ORTX",1))=$E($P(^(0),"^"),1,40)_"," D
25 .I $D(RAMOD) S ORETURN("ORTX",2)="Modifiers: "_$E(RAMOD,1,80)_","
26 .S ORETURN("ORTX",3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_","
27 .I $P(RAORD0,"^",19)]"" S X=$P(RAORD0,"^",19),ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Transport: "_$S(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_","
28 .I $P($G(^DPT(+RADFN,0)),"^",2)'="M" S ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"")
29 .S ORETURN("ORIT")=$P(^RAO(75.1,+RAOIFN,0),"^",2)_";RAMIS(71,"
30 I '$D(RAF1),('$P(RAEXM0,"^",25)) D ; if orphan, display text now
31 . W !?3,"...will now designate request status as 'COMPLETE'..."
32 . Q
33 D ^RAORDU ; Update the request status
34 I '$D(RAF1),('$P(RAEXM0,"^",25)) D ; if orphan, display text now
35 . W !?10,"...request status successfully updated."
36 . Q
37 Q
Note: See TracBrowser for help on using the repository browser.