Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL1.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/RAUTL1.m
r628 r636 1 1 RAUTL1 ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Utility Routine ;10/22/97 13:54 2 ;;5.0;Radiology/Nuclear Medicine;**5,9,18,71,82 ,81,84**;Mar 16, 1998;Build 132 ;;5.0;Radiology/Nuclear Medicine;**5,9,18,71,82**;Mar 16, 1998;Build 8 3 3 ;last modification by SS for P18 June 19,00 4 4 ;02/10/2006 BAY/KAM RA*5*71 Add ability to update exam data to V/R 5 ;6 ;Integration Agreements7 ;----------------------8 ;DIC(10006); DIE(10018); FILE^DIE(2053); UPDATE^DIE(2053); EN^ORB3(1362); NOTE^ORX3(868)9 ;10 5 I "IOSCR"'[X!(X="") S X="Unknown" Q 11 6 G @($E(X)) … … 36 31 ;Variable Y is returned as either an elapsed time in the form DD:HH:MM where DD=days, HH=hours, MM=minutes or as the string 'Neg. Time' indicating a negative elapsed time 37 32 ;Variable Y1 is returned as the # of minutes of elapsed time 38 I '$D(RAMTIME) S DIC="^DD(""FUNC"",",DIC(0)="FX",RAX=X,X="MINUTES" D ^DIC K DIC S X=RAX S:$D(^DD("FUNC",+Y,1)) RAMTIME=^(1) I '$D(RAMTIME) W $C(7),!!,"Can't continue --- No 'MINUTES' function found in File Manager" K Y,Y1 G Q33 I '$D(RAMTIME) S DIC="^DD(""FUNC"",",DIC(0)="FX",RAX=X,X="MINUTES" D ^DIC K DIC S X=RAX S:$D(^DD("FUNC",+Y,1)) RAMTIME=^(1) I '$D(RAMTIME) W *7,!!,"Can't continue --- No 'MINUTES' function found in File Manager" K Y,Y1 G Q 39 34 X RAMTIME S Y1=X I X<0 S Y="Neg. Time" G Q 40 35 MINUTS S X(1)=X\1440,X=X-(1440*X(1)),X(2)=X\60,X(3)=X-(60*X(2)),Y=$E(100+X(1),2,3)_":"_$E(100+X(2),2,3)_":"_$E(100+X(3),2,3) … … 46 41 I $G(RAIMGTY)="" K XQUIT Q ; didn't sign-on to an imaging location 47 42 D ^RACNLU G UPQ:"^"[X 48 I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",DUZ)) W !!?3, $C(7),"You do not have the appropriate access privileges to act on completed exams." G UPDATE49 I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3, $C(7),"Exam has been 'cancelled' therefore the status cannot be changed." G UPDATE43 I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",DUZ)) W !!?3,*7,"You do not have the appropriate access privileges to act on completed exams." G UPDATE 44 I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,*7,"Exam has been 'cancelled' therefore the status cannot be changed." G UPDATE 50 45 ;D UP1 I RAOR>0 S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"",",DR="100///""NOW""",DR(2,70.07)="2///U;3////"_$S($G(RADUZ):RADUZ,1:DUZ) D ^DIE 51 46 D UP1 I RAOR>0 D 52 .L +^RADPT(RADFN,"DT",RADTI,"P",RACNI) :$G(DILOCKTM,3)47 .L +^RADPT(RADFN,"DT",RADTI,"P",RACNI) 53 48 .N RAIEN 54 49 .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," … … 56 51 .K RAERR D UPDATE^DIE("E","RAFDA","RAIEN","RAERR") 57 52 .K RAFDA,RAIENS 58 .I $D(RAERR) S RAERR="Error in update of 70.07, .01 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR")L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) K RAIEN Q53 .I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) K RAIEN Q 59 54 .S RAIENS=RAIEN(1)_","_RACNI_","_RADTI_","_RADFN_"," 60 55 .S RAFDA(70.07,RAIENS,2)="U" 61 56 .S RAFDA(70.07,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ) 62 .D FILE^DIE(,"RAFDA" ,"RAERR")57 .D FILE^DIE(,"RAFDA") 63 58 .L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 64 .I $D(RAERR) S RAERR="Error in update of 70.07, 2,3 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR")65 59 UPQ K RAFDA,RAIENS 66 60 K %,D,DA,DE,DIC,DIE,DQ,DR,I,J,POP,RACS,RAEND,RAF5,RAFL,RAFST,RAI,RAIX,RAJ1,RAORDIFN,RAPRIT,RAHEAD,RASN,RAOR,RASTI,RASSN,RADATE,RAST,RACN,RACNI,RADFN,RADTE,RADTI,RANME,RAPRC,RARPT,X,Y,Z,^TMP($J,"RAEX"),C,DIPGM Q … … 96 90 ;S DR(2,70.05)=$S($P(RAMDV,"^",11)&('$D(ZTQUEUED)):".01;",1:"")_"2////"_RASTI_";3////"_$S($G(RADUZ):RADUZ,1:DUZ) 97 91 ;D ^DIE 98 L +^RADPT(RADFN,"DT",RADTI,"P",RACNI) :$G(DILOCKTM,3)92 L +^RADPT(RADFN,"DT",RADTI,"P",RACNI) 99 93 N RAIEN 100 94 S RAIENS=RACNI_","_RADTI_","_RADFN_"," 101 95 S RAFDA(70.03,RAIENS,3)=RASTI 102 96 K RAERR D FILE^DIE(,"RAFDA","RAERR") 103 I $D(RAERR) S RAERR="Error in update of 70.03 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR")L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) G UP2K ;L - P1897 I $D(RAERR) L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) G UP2K ;L - P18 104 98 I $P(RAMDV,"^",10) D 105 .N RAERR2106 99 .S RAIENS="+1,"_RACNI_","_RADTI_","_RADFN_"," 107 100 .S RAFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) 108 .D UPDATE^DIE(,"RAFDA","RAIEN" ,"RAERR")101 .D UPDATE^DIE(,"RAFDA","RAIEN") 109 102 .K RAFDA,RAIENS 110 .I $D(RAERR) S RAERR="Error in update of 70.05, .01 "_$G(RAERR("DIERR",1,"TEXT",1)) K RAERR("DIERR")111 103 .Q:'$D(RAIEN(1)) 112 104 .I $P(RAMDV,"^",11),('$D(ZTQUEUED)) D … … 117 109 .S RAFDA(70.05,RAIENS,2)=RASTI 118 110 .S RAFDA(70.05,RAIENS,3)=$S($G(RADUZ):RADUZ,1:DUZ) 119 .K RAERR2 D FILE^DIE(,"RAFDA","RAERR2") 120 .I $D(RAERR2) S RAERR2="Error in update of 70.05 2,3 "_$G(RAERR2("DIERR",1,"TEXT",1)),RAERR=$S($D(RAERR):RAERR_";"_RAERR2,1:RAERR2) 111 .K RAERR2 D FILE^DIE(,"RAFDA") 121 112 ;Patch RA*5*82 added next line send EXM message after status update, not before the update 122 D :'$D(RAERR)EXM^RAHLRPC113 D EXM^RAHLRPC 123 114 L -^RADPT(RADFN,"DT",RADTI,"P",RACNI) 124 115 ;
Note:
See TracChangeset
for help on using the changeset viewer.