Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD1.m
r613 r623 1 MAGJUPD1 ;WOIFO/JHC VistARad Update Exam Status ; 29 Jul 2003 10:02 AM 2 ;;3.0;IMAGING;**16,22,18,76**;Jun 22, 2007;Build 19 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 RPC's to update Exam Status to "Interpreted", and 21 ; for "Closing" a case that is open on the DX Workstation 22 ; 23 ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^Server Program Error: "_ERR 24 D @^%ZOSF("ERRTN") 25 Q:$Q 1 Q 26 ; 27 STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE 28 ; Update Exam Status to "Interpreted" and/or Close the exam 29 ; Only updates the Status if the current value is "Examined" 30 ; This routine defines variables needed for calling the Radiology 31 ; package routine UP1^RAUTL1, for filing Status updates 32 ; 33 ; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY 34 ; UPDFLAG = 1/0 -- 1 to perform update; else no update made 35 ; RARPT = ptr to Rad Exam Report file 36 ; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam 37 ; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data 38 ; MAGGRY = return results in @MAGGRY 39 ; 40 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1" 41 N RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET 42 N RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP 43 N UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST 44 S MAGLST="MAGJUPDATE" 45 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value 46 S DIQUIET=1 D DT^DICRW 47 S TIMESTMP=$$NOW^XLFDT() 48 S UPDFLAG=$P(PARAMS,U),RADFN=$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=$P(PARAMS,U,4),RARPT=$P(PARAMS,U,5),UPDPSKEY=+$P(PARAMS,U,6) 49 S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update" 50 S RAPRTSET=0 51 I RADFN,RADTI,RACNI 52 E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")" G STATUSZ 53 D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET) 54 I 'MAGRET S REPLY="0^4~Current Case Not Accessible for Updating" G STATUSZ 55 ; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA, 56 ; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM 57 ;11 RAST DAYCASE RAELOC RASTP RASTORD 58 ;16 RADTPRT 59 S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) 60 S RAEXT=$P(RADATA,U,12),RACNE=$P(RAEXT,"-",2),RADTE=$P(RADATA,U,7) 61 S RAINT=RADTI_"-"_RACNI 62 D CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA) ; unlock the case 63 ; proceed only if case was locked by this user 64 ; if it was not Locked, then do NOT update PS, Key Images 65 I 'RSL S REPLY=RSL,UPDPSKEY=0 G STATUSZ 66 I 'UPDFLAG S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed" G STATUSZ 67 S RIST=$P(RSL,U,2) ; CLOSE reports back the type of radiologist 68 ; now we know this user had locked the case, & wants to do Status update 69 D EN2^RAUTL20(.MAGPSET) ; get info re rad PrintSet 70 ; 71 ; IF exam is not "Examined", and not "Cancelled" and past "Waiting" 72 ; then assume it has already been updated via another pathway, 73 ; either as printset member (via code at tag PRTSET, below), 74 ; or from a voice-dictation or terminal session by the radiologist 75 ; For these cases, no warning msg is sent 76 ; Else, update not allowed, so give warning msg 77 ; Note that when the Exam was OPENed, it must have had status "Examined" 78 I '$D(^RA(72,"AVC","E",$P(RADATA,U,11))) D G STATUSX:(+$P(REPLY,U,2)=1),STATUSZ ; Current Status MUST be "Examined" Category 79 . I $P(RADATA,U,15)>2 D ; assume update has otherwise been done, eg voice dictation or manual entry in Vista 80 .. S RACNILST=RACNI,RASTI=$P(RADATA,U,11) ; need for code at tag statusx 81 .. I RAPRTSET S REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated" 82 .. E S REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14) 83 . E S REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14) 84 ; 85 ; now ready to update exam status 86 S RAMDV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3) 87 S RAMDV=$TR(^RA(79,RAMDV,.1),"YyNn","1100") 88 ; 89 ; Update interpreting radiologist field in Rad file 90 I RIST D I RACNILST="" G STATUSZ 91 . N SAVRACNI,RTN S RACNILST="" 92 PRTSET . ; if exam is part of Rad Print-Set, then update all exams of printset 93 . I RAPRTSET D 94 .. S ACNLST="",SAVRACNI=RACNI,X=0 95 .. F I=0:1 S X=$O(MAGPSET(X)) Q:'X S RACNILST=RACNILST_$S(I:U,1:"")_X S:RACNE'=+MAGPSET(X) ACNLST=ACNLST_", "_"-"_+MAGPSET(X) 96 . E S RACNILST=RACNI 97 . F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D I RACNILST="" Q 98 .. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI 99 .. D STUFPHY^RARIC1(DUZ,RIST,.RTN) 100 .. I 'RTN S REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"." S RACNILST="" 101 . I RAPRTSET S RACNI=SAVRACNI 102 S RAONLINE=1,ZTQUEUED=1 D UP1^RAUTL1 ; Suppress msgs, do Status update 103 ;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs 104 I RAOR<0 S REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$S($G(RASN)]"":RASN,1:"Unknown") 105 I G STATUSZ 106 ; 107 S REPLY="0^1~For Case #"_$S($G(ACNLST)]"":"s ",1:"")_RAEXT_$S(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN 108 ; 109 STATUSX ; Newly Interpreted exam: 110 ; Log the Interpreted event 111 D LOG^MAGJUTL3("VR-INT",LOGDATA) 112 ; Update Recent Exams List 113 G STATUSZ:'$P(^MAG(2006.69,1,0),U,8) ; no bkgnd compile enabled 114 L +^XTMP("MAGJ2","RECENT"):5 115 E G STATUSZ 116 N INDX F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D 117 . S INDX=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=INDX,^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI 118 L -^XTMP("MAGJ2","RECENT") 119 STATUSZ ; 120 ; store PS, Key Image data 121 I UPDPSKEY,($D(DATA)>9) D 122 . D SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X) 123 . S REPLY=REPLY_$P(X,"~",2,99) 124 S @MAGGRY@(0)=REPLY 125 K ^TMP($J,"MAGRAEX"),^("RAE1") 126 Q 127 ; 128 CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case 129 ; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG 130 ; 131 ; DFN,DTI,CNI,RPT = pointers to Rad File for the exam 132 ; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine 133 ; STATUS, above (which has already called GETEXAM) 134 ; RSL = return result of the Close 135 ; This subroutine may be called directly (to close a case without 136 ; doing a status update), or is called from tag STATUS, above, when 137 ; also doing a status update 138 ; 139 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1" 140 N RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK 141 S DFN=$P(PARAMS,U),DTI=$P(PARAMS,U,2),CNI=$P(PARAMS,U,3),RPT=$P(PARAMS,U,4),UPDFLAG=$P(PARAMS,U,5) 142 S LOGDATA="" 143 I $P($G(^MAG(2006.69,1,0)),U,4) 144 E S REPLY=$S(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"") G CLOSEZ ; Status Update NOT Enabled 145 S RIST=+MAGJOB("USER",1) I RIST 146 E S REPLY=$S(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"") G CLOSEZ ; need only unlock a radiologist 147 I DFN,DTI,CNI 148 E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken" G CLOSEZ 149 ; 150 I 'UPDFLAG N RADATA D I 'MAGRET G CLOSEZ 151 . D GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET) 152 . I 'MAGRET S REPLY="0^4~No Current Case accessible to close--no action taken" 153 . E S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) 154 S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12) 155 I RARPT,DAYCASE 156 E S REPLY="0^4~Current Case not accessible to close--no action taken" G CLOSEZ 157 ; 158 D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK) 159 S LOGDATA=$P(MYLOCK(1),"|",2) 160 I 'MYLOCK(1) S X=$P(MYLOCK(1),U,4) D S LOGDATA="" G CLOSEZ 161 . I UPDFLAG S REPLY="0^1~Case #"_DAYCASE_$S(X]"":" locked by "_X,1:" not locked by "_$P(MAGJOB("USER",1),U,2))_"--No Status update performed" 162 . E S REPLY="0^1~ " ; case wasn't opened by this R'ist; nothing to do 163 ; 164 I UPDFLAG S REPLY=1_U_RIST 165 E S REPLY="0^1~Case #"_DAYCASE_$S(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed." 166 CLOSEZ S RSL=REPLY 167 Q 168 ; 169 END Q ; 1 MAGJUPD1 ;WOIFO/JHC VistARad Update Exam Status ; 29 Jul 2003 10:02 AM 2 ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006 3 ;; +---------------------------------------------------------------+ 4 ;; | Property of the US Government. | 5 ;; | No permission to copy or redistribute this software is given. | 6 ;; | Use of unreleased versions of this software requires the user | 7 ;; | to execute a written test agreement with the VistA Imaging | 8 ;; | Development Office of the Department of Veterans Affairs, | 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 ;; | The Food and Drug Administration classifies this software as | 12 ;; | a medical device. As such, it may not be changed in any way. | 13 ;; | Modifications to this software may result in an adulterated | 14 ;; | medical device under 21CFR820, the use of which is considered | 15 ;; | to be a violation of US Federal Statutes. | 16 ;; +---------------------------------------------------------------+ 17 ;; 18 Q 19 ; Subroutines for RPC's to update Exam Status to "Interpreted", and 20 ; for "Closing" a case that is open on the DX Workstation 21 ; 22 ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^Server Program Error: "_ERR 23 D @^%ZOSF("ERRTN") 24 Q:$Q 1 Q 25 ; 26 STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE 27 ; Update Exam Status to "Interpreted" and/or Close the exam 28 ; Only updates the Status if the current value is "Examined" 29 ; This routine defines variables needed for calling the Radiology 30 ; package routine UP1^RAUTL1, for filing Status updates 31 ; 32 ; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY 33 ; UPDFLAG = 1/0 -- 1 to perform update; else no update made 34 ; RARPT = ptr to Rad Exam Report file 35 ; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam 36 ; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data 37 ; MAGGRY = return results in @MAGGRY 38 ; 39 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1" 40 N RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET 41 N RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP 42 N UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST 43 S MAGLST="MAGJUPDATE" 44 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value 45 S DIQUIET=1 D DT^DICRW 46 D NOW^%DTC S TIMESTMP=% 47 S UPDFLAG=$P(PARAMS,U),RADFN=$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=$P(PARAMS,U,4),RARPT=$P(PARAMS,U,5),UPDPSKEY=+$P(PARAMS,U,6) 48 S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update" 49 S RAPRTSET=0 50 I RADFN,RADTI,RACNI 51 E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")" G STATUSZ 52 D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET) 53 I 'MAGRET S REPLY="0^4~Current Case Not Accessible for Updating" G STATUSZ 54 ; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA, 55 ; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM 56 ;11 RAST DAYCASE RAELOC RASTP RASTORD 57 ;16 RADTPRT 58 S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) 59 S RAEXT=$P(RADATA,U,12),RACNE=$P(RAEXT,"-",2),RADTE=$P(RADATA,U,7) 60 S RAINT=RADTI_"-"_RACNI 61 D CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA) ; unlock the case 62 ; proceed only if case was locked by this user 63 ; if it was not Locked, then do NOT update PS, Key Images 64 I 'RSL S REPLY=RSL,UPDPSKEY=0 G STATUSZ 65 I 'UPDFLAG S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed" G STATUSZ 66 S RIST=$P(RSL,U,2) ; CLOSE reports back the type of radiologist 67 ; now we know this user had locked the case, & wants to do Status update 68 D EN2^RAUTL20(.MAGPSET) ; get info re rad PrintSet 69 ; 70 ; IF exam is not "Examined", and not "Cancelled" and past "Waiting" 71 ; then assume it has already been updated via another pathway, 72 ; either as printset member (via code at tag PRTSET, below), 73 ; or from a voice-dictation or terminal session by the radiologist 74 ; For these cases, no warning msg is sent 75 ; Else, update not allowed, so give warning msg 76 ; Note that when the Exam was OPENed, it must have had status "Examined" 77 I '$D(^RA(72,"AVC","E",$P(RADATA,U,11))) D G STATUSX:(+$P(REPLY,U,2)=1),STATUSZ ; Current Status MUST be "Examined" Category 78 . I $P(RADATA,U,15)>2 D ; assume update has otherwise been done, eg voice dictation or manual entry in Vista 79 .. S RACNILST=RACNI,RASTI=$P(RADATA,U,11) ; need for code at tag statusx 80 .. I RAPRTSET S REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated" 81 .. E S REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14) 82 . E S REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14) 83 ; 84 ; now ready to update exam status 85 S RAMDV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3) 86 S RAMDV=$TR(^RA(79,RAMDV,.1),"YyNn","1100") 87 ; 88 ; Update interpreting radiologist field in Rad file 89 I RIST D I RACNILST="" G STATUSZ 90 . N SAVRACNI,RTN S RACNILST="" 91 PRTSET . ; if exam is part of Rad Print-Set, then update all exams of printset 92 . I RAPRTSET D 93 .. S ACNLST="",SAVRACNI=RACNI,X=0 94 .. F I=0:1 S X=$O(MAGPSET(X)) Q:'X S RACNILST=RACNILST_$S(I:U,1:"")_X S:RACNE'=+MAGPSET(X) ACNLST=ACNLST_", "_"-"_+MAGPSET(X) 95 . E S RACNILST=RACNI 96 . F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D I RACNILST="" Q 97 .. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI 98 .. D STUFPHY^RARIC1(DUZ,RIST,.RTN) 99 .. I 'RTN S REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"." S RACNILST="" 100 . I RAPRTSET S RACNI=SAVRACNI 101 S RAONLINE=1,ZTQUEUED=1 D UP1^RAUTL1 ; Suppress msgs, do Status update 102 ;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs 103 I RAOR<0 S REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$S($G(RASN)]"":RASN,1:"Unknown") 104 I G STATUSZ 105 ; 106 S REPLY="0^1~For Case #"_$S($G(ACNLST)]"":"s ",1:"")_RAEXT_$S(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN 107 ; 108 STATUSX ; Newly Interpreted exam: 109 ; Log the Interpreted event 110 D LOG^MAGJUTL3("VR-INT",LOGDATA) 111 ; Update Recent Exams List 112 G STATUSZ:'$P(^MAG(2006.69,1,0),U,8) ; no bkgnd compile enabled 113 L +^XTMP("MAGJ2","RECENT"):5 114 E G STATUSZ 115 N INDX F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D 116 . S INDX=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=INDX,^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI 117 L -^XTMP("MAGJ2","RECENT") 118 STATUSZ ; 119 ; store PS, Key Image data 120 I UPDPSKEY,($D(DATA)>9) D 121 . D SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X) 122 . S REPLY=REPLY_$P(X,"~",2,99) 123 S @MAGGRY@(0)=REPLY 124 K ^TMP($J,"MAGRAEX"),^("RAE1") 125 Q 126 ; 127 CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case 128 ; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG 129 ; 130 ; DFN,DTI,CNI,RPT = pointers to Rad File for the exam 131 ; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine 132 ; STATUS, above (which has already called GETEXAM) 133 ; RSL = return result of the Close 134 ; This subroutine may be called directly (to close a case without 135 ; doing a status update), or is called from tag STATUS, above, when 136 ; also doing a status update 137 ; 138 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1" 139 N RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK 140 S DFN=$P(PARAMS,U),DTI=$P(PARAMS,U,2),CNI=$P(PARAMS,U,3),RPT=$P(PARAMS,U,4),UPDFLAG=$P(PARAMS,U,5) 141 S LOGDATA="" 142 I $P($G(^MAG(2006.69,1,0)),U,4) 143 E S REPLY=$S(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"") G CLOSEZ ; Status Update NOT Enabled 144 S RIST=+MAGJOB("USER",1) I RIST 145 E S REPLY=$S(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"") G CLOSEZ ; need only unlock a radiologist 146 I DFN,DTI,CNI 147 E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken" G CLOSEZ 148 ; 149 I 'UPDFLAG N RADATA D I 'MAGRET G CLOSEZ 150 . D GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET) 151 . I 'MAGRET S REPLY="0^4~No Current Case accessible to close--no action taken" 152 . E S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) 153 S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12) 154 I RARPT,DAYCASE 155 E S REPLY="0^4~Current Case not accessible to close--no action taken" G CLOSEZ 156 ; 157 D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK) 158 S LOGDATA=$P(MYLOCK(1),"|",2) 159 I 'MYLOCK(1) S X=$P(MYLOCK(1),U,4) D S LOGDATA="" G CLOSEZ 160 . I UPDFLAG S REPLY="0^1~Case #"_DAYCASE_$S(X]"":" locked by "_X,1:" not locked by "_$P(MAGJOB("USER",1),U,2))_"--No Status update performed" 161 . E S REPLY="0^1~ " ; case wasn't opened by this R'ist; nothing to do 162 ; 163 I UPDFLAG S REPLY=1_U_RIST 164 E S REPLY="0^1~Case #"_DAYCASE_$S(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed." 165 CLOSEZ S RSL=REPLY 166 Q 167 ; 168 END Q ;
Note:
See TracChangeset
for help on using the changeset viewer.
