Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX1B.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX1B.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX1B.m
r613 r623 1 MAGJEX1B 2 ;;3.0;IMAGING;**16,22,18,65,76**;Jun 22, 2007;Build 19 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 IMGLOOP 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 IMGLOOPZ 64 65 66 LOCKIN(RARPT,LOCKLEV,MYLOCK,LOCKCHK) 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 REMLOCK 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0) 118 119 120 121 122 END 1 MAGJEX1B ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003 9:58 AM 2 ;;3.0;IMAGING;**16,22,18,65**;Jul 27, 2006;Build 28 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 11 ;; | | 12 ;; | The Food and Drug Administration classifies this software as | 13 ;; | a medical device. As such, it may not be changed in any way. | 14 ;; | Modifications to this software may result in an adulterated | 15 ;; | medical device under 21CFR820, the use of which is considered | 16 ;; | to be a violation of US Federal Statutes. | 17 ;; +---------------------------------------------------------------+ 18 ;; 19 Q 20 ; Subroutines for fetch exam images, exam lock/reserve, remove dangling locks 21 ; 22 IMGLOOP ; get data for all the images 23 ; This subroutine is called from MAGJEX1 24 ; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled; 25 ; all references to MAGGRY use subscript indirection 26 N DFN,IMGREC,P18ALTP 27 I '$D(MAGJOB("ALTPATH")) S MAGJOB("ALTPATH")=0 ; facilitates testing 28 F IMAG=MAGSTRT:1:MAGEND S MAGIEN=$P(MAGS(IMAG),U,4) D 29 . S DFN=$P(MAGS(IMAG),U,8) 30 . I DFN=RADFN S MIXEDUP(RADFN)="" ;ok 31 . E S:'DFN DFN=0 S MIXEDUP=MIXEDUP+2,MIXEDUP(DFN)="" ; database corruption 32 . S MDL=$P(MAGS(IMAG),U,3) 33 . I MDL="DR" S MDL="CR" ; for now, hard code cx of non-standard code 34 . I $G(SERBRK),(SERLBL]"") D ; mark Begin of series 35 . . S CT=CT+1,@MAGGRY@(CT+STARTNOD)=SERLBL,SERLBL="" 36 . S MAGXX=MAGIEN D 37 . . I 'USETGA,($P(MAGS(IMAG),U,2)["BIG") D BIG^MAGFILEB Q 38 . . E D VST^MAGFILEB 39 . I MAGJOB("ALTPATH") S X=$P(MAGS(IMAG),U,6),P18ALTP="" I X]"" D 40 . . F I=1:1:$L(X,",") S T=$P(X,",",I) I T S CURPATHS(T)="" I 'MAGJOB("P32"),$D(MAGJOB("LOC",T)) S P18ALTP=P18ALTP_$S(P18ALTP="":"",1:",")_T 41 . S IMGREC="B2^"_MAGIEN_U_MAGFILE2 42 . I 'MAGJOB("P32") D 43 . . S T="",X=$P(MAGS(IMAG),U,11) I X]"" F I="K","I","U" I X[I,$D(PSIND(I)) S T=T_$S(T="":"",1:",")_I ; PS_Indicators 44 . . S IMGREC=IMGREC_U_T_U_$S(MAGJOB("ALTPATH"):P18ALTP,1:"") ; AltPaths for this img 45 . . I '(PROCDT]"") D ; Img Process Date 46 . . . S X=$P(MAGS(IMAG),U,12) I X]"" S T=$S($E(X)=3:20,$E(X)=2:19,1:"") I T S PROCDT=T_$E(X,2,7) 47 . . I '(ACQSITE]"") D ; Acq Site 48 . . . S X=$P(MAGS(IMAG),U,13) I X]"" S ACQSITE=X 49 . S CT=CT+1,@MAGGRY@(CT+STARTNOD)=IMGREC 50 . I MODALITY="" D 51 . . I 'MAGJOB("P32") S MODALITY=MDL Q 52 . . N T S T=$P("1dummy1^CT^CR^MR^US^AS^CD^CS^DG^EC^FA^LP^MA^PT^ST^XA^NM^OT^BI^CP^DD^DM^ES^FS^LS^MS^RG^TG^RF^RTIMAGE^RTSTRUCT^HC^RTDOSE^RTPLAN^RTRECORD^DX^MG^IO^PX",U_MDL_U,1) 53 . . S MODALITY=$L(T,U) 54 . . I MODALITY>38 S MODALITY=9999 ; 38=TOTAL # modalities defined; else 9999 55 . . I STKLAY S OPENCNT=0 ; no limit on WS for # of exams open in StackVwr 56 ; 57 I 'MAGJOB("ALTPATH") S ALTPATH=-1 58 E D 59 . S T=0 F S T=$O(CURPATHS(T)) Q:'T I $D(MAGJOB("LOC",T)) Q 60 . S ALTPATH=$S('T:0,1:1) 61 . I ALTPATH=$P(MAGJOB("ALTPATH"),U,2) S ALTPATH=-1 62 . E S $P(MAGJOB("ALTPATH"),U,2)=ALTPATH 63 IMGLOOPZ Q 64 ; 65 ; 66 LOCKIN(RARPT,LOCKLEV,MYLOCK,LOCKCHK) ; init lock-related info B4 do any lock actions 67 ; called from UTL3 & EX1A 68 ; if LOCKCHK="STATUS", only return current status 69 ; Input RARPT (required) and LOCKCHK (opt) 70 ; Output: LOCKLEV & MYLOCK array; successful LOCKS left intact, unless LOCKCHK="STATUS" 71 ; M LOCKS det. what Actions are possible by calling program modules 72 ; MYLOCK(1/2)= Lock_is_Mine ^ DUZ ^ $J ^ User Name ^ User Init ^ Case # 73 ; LOCKLEV=0:3--is/not 1-Lockable/2-Reservable/3-Both to user 74 ; MYLOCK=0:3--is/not already 1-Locked/2-Reserved/3-Both by user 75 ; 76 N CKMINE,CASENO,XX,XY,ILOCK 77 S LOCKCHK=$G(LOCKCHK)="STATUS" 78 S LOCKLEV=0 K MYLOCK S MYLOCK=0 79 L +^XTMP("MAGJ","LOCK",RARPT):0 80 I S LOCKLEV=3 81 L +^XTMP("MAGJ","LOCK",RARPT,1):0 ; "1" for Exam "LOCK" 82 I S:'LOCKLEV LOCKLEV=1 83 L +^XTMP("MAGJ","LOCK",RARPT,2):0 ; "2" for Exam "RESERVE" 84 I S LOCKLEV=$S('LOCKLEV:2,1:3) 85 L -^XTMP("MAGJ","LOCK",RARPT) 86 S CKMINE=DUZ_U_$J 87 F ILOCK=1,2 D 88 . S XX="",XY="",CASENO=$G(^XTMP("MAGJ","LOCK",RARPT,ILOCK)) 89 . I CASENO]"" S XX=$G(^XTMP("MAGJ","LOCK",RARPT,ILOCK,CASENO)),XY=$P(XX,"|",2),XX=$P(XX,"|") 90 . S X=$P(XX,U,1,2),MYLOCK(ILOCK)=(X=CKMINE) 91 . S X=$P(XX,U)_U_$P(XX,U,2)_U_$P(XX,U,4)_U_$P(XX,U,5)_U_CASENO_U_"|"_XY 92 . S MYLOCK(ILOCK)=MYLOCK(ILOCK)_U_X 93 . I MYLOCK(ILOCK) S MYLOCK=MYLOCK+ILOCK 94 I LOCKCHK,LOCKLEV D ; reset locks for Lock check 95 . I LOCKLEV=1!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,1) 96 . I LOCKLEV=2!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,2) 97 Q 98 ; 99 REMLOCK ; Remove dangling exam locks; this is run only at Logon 100 ; If a recorded lock is found that a new job (logon) can M-Lock 101 ; then that is a dangling lock that must be removed 102 N RARPT,TS,LOCKLEV,MYLOCK,ACTION,DAYCASE,ILOCK,RESULT 103 S RARPT="" 104 F S RARPT=$O(^XTMP("MAGJ","LOCK",RARPT)) Q:'RARPT D ; loop thru recorded locks 105 . D LOCKIN(RARPT,.LOCKLEV,.MYLOCK) 106 . I 'LOCKLEV Q ;unable to lock--is ok 107 . S ACTION="",DAYCASE="" 108 . F ILOCK=1,2 I $D(^XTMP("MAGJ","LOCK",RARPT,ILOCK)) S XX=^(ILOCK) D 109 . . I DAYCASE="" S DAYCASE=$P(XX,U) 110 . . I ILOCK=1,(LOCKLEV=1!(LOCKLEV=3)) S $P(ACTION,U,1)=1 111 . . I ILOCK=2,(LOCKLEV=2!(LOCKLEV=3)) S $P(ACTION,U,2)=1 112 . I 'ACTION,'+$P(ACTION,U,2),(DAYCASE="") D Q ; should never occur, but 113 . . I LOCKLEV=1!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,1) 114 . . I LOCKLEV=2!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,2) 115 . D LOCKOUT^MAGJEX1A(RARPT,DAYCASE,.LOCKLEV,.MYLOCK,ACTION,.RESULT) ; 1st, lock to me 116 . K LOCKLEV,MYLOCK D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; then, clear the lock 117 S TS="" F I=2,0 S %H=$H+I D YMD^%DTC S TS=TS_$S(TS="":"",1:U)_X 118 S ^XTMP("MAGJ",0)=TS_U_"VistaRad Locks" 119 Q 120 ; 121 ; 122 END ;
Note:
See TracChangeset
for help on using the changeset viewer.
