Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX2.m
r613 r623 1 MAGJEX2 ;;WIRMFO/JHC Rad. Workstation RPC calls;[ 02/25/2000 4:40 PM ] ; 09 Jun 2003 2:58 PM 2 ;;3.0;IMAGING;**51,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 pre-fetch/ auto-display prior exams' images 21 ; Entry Points: 22 ; PRIOR1 -- Pre-Fetch/Auto-Display images for other related cases; 23 ; RPC Call: MAGJ PRIOREXAMS 24 ; PREFETCH -- Pre-Fetch initiated from 25 ; 26 Q 27 ERR N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^Server Program Error: "_ERR 28 D @^%ZOSF("ERRTN") 29 Q:$Q 1 Q 30 PREFETCH ; Entry point from HL7 processing, to initiate prefetch at 31 ; time of radiology "Register Patient for Exam" function 32 ; Do not process if the exam is being Canceled (RACANC true) 33 ; 34 N RET S RET="" 35 I '$P($G(^MAG(2006.69,1,0)),U,5) G PREFQ ; Prefetch disabled 36 I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) G PREFQ ; Required vars 37 D PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI) 38 PREFQ ; W !,"End PRE-FETCH RET=" N JHC R JHC ZW RET 39 Q 40 ; 41 PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams 42 ; This ep also called as subroutine from routing software (P51) 43 ; MAGGRY - return array of exams to PreFetch, or Auto-send to RAD W/S 44 ; DATA: - input params for the Current Exam 45 ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk) 46 ; = A -- Auto-route priors 47 ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file 48 ; 3) RADTI = "" "" "" "" 49 ; 4) RACNI = "" "" "" "" 50 ; 5) RARPT - Case pointer to ^RARPT global 51 ; 52 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX2" 53 K MAGGRY 54 N RADFN,RADTI,RACNI,RARPT,RADATA 55 N DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT 56 S ACTION=$P(DATA,U) 57 I ACTION="P"!(ACTION="A") 58 E S MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")" G PRIOR1Z 59 S MAGDFN=$P(DATA,U,2),MAGDTI=$P(DATA,U,3),MAGCNI=$P(DATA,U,4) 60 I MAGDFN,MAGDTI,MAGCNI 61 E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")" G PRIOR1Z 62 S DIQUIET=1 D DT^DICRW 63 N MAGJOB D MAGJOBNC^MAGJUTL3 64 S HDR=$S(ACTION="P":"Pre-fetch",ACTION="A":"Auto-Display",1:"???")_" Prior Exams for CASE: " 65 I '$D(^DPT(MAGDFN,0)) S MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")" G PRIOR1Z 66 I $D(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI)) 67 E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")" G PRIOR1Z 68 S MAGRACNT=0 69 S MAGGRY(0)="0^Compiling Prior Radiology Exams" 70 D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) ; Current Exam only 71 S RADFN=MAGDFN,RADTI=MAGDTI,RACNI=MAGCNI 72 I 'MAGRET S MAGGRY(0)="0^Current Case is Not Accessible" G PRIOR1Z 73 S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) S DAYCASE=$P(RADATA,U,12) D SVMAG2A 74 I 'MAGGRY(0) S MAGGRY(0)="0^Current Case either has no CPT code, or has no rules defined for its CPT code." G PRIOR1Z 75 S HDR=HDR_DAYCASE 76 D SRCH(MAGDFN) ; Search prior exams for this patient 77 PRIOR1Z ; 78 I 'MAGGRY(0) S:(MAGGRY(0)["Compiling") MAGGRY(0)="0^No Exams Found" 79 E I +MAGGRY(0)=1 S MAGGRY(0)="0^No Prior Exams Found" K MAGGRY(1) 80 E D SVMAG2B 81 K ^TMP($J,"MAGRAEX"),^("RAE1") 82 Q 83 ; 84 SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total 85 ; numbers of exams to consider 86 N BEGDT,LIMYRS,LIMEXAMS,X 87 S X=$G(^MAG(2006.69,1,0)) 88 S LIMYRS=+$P(X,U,14),LIMEXAMS=+$P(X,U,15) 89 S:'LIMYRS LIMYRS=7 S:'LIMEXAMS LIMEXAMS=50 ; default limit # Exams 90 S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7) 91 I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS 92 S MAGRACNT=1 D GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS) 93 I MAGRET N IDAT S IDAT=1 D 94 . F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT S RADATA=^(IDAT,1) D 95 .. S RADTI=$P(RADATA,U,2),RACNI=$P(RADATA,U,3) 96 .. I RADTI=MAGDTI&(RACNI=MAGCNI) Q ; skip current case 97 .. D SVMAG2A 98 Q 99 ; 100 SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1 101 ; Find all the patient's exams whose CPT codes are related to the 102 ; Current exam's CPT code, according to dictionary 2006.65 103 N RAIMGTYP 104 N CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH 105 S RARPT=+$P(RADATA,U,10) 106 I MAGGRY(0) Q:'$P(MAGGRY(1),U) ; Cur Case CPT not in map file 107 I Q:(ACTION="P")&'$D(^RARPT(RARPT,2005)) ; nothing to pre-fetch 108 I Q:$P(RADATA,U,15)<2 ; Cancel or Waiting 109 ; Note: if no images, may still want to do Auto-Disp to get Report; 110 ; also, Current Case should still proceed 111 S CPT=$P(RADATA,U,17) 112 Q:'CPT ; algorithm REQUIRES CPT codes be used 113 S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3) 114 S MAGMATCH="^^" 115 I 'MAGGRY(0) D Q:'MAGMATCH ; No rules defined for Cur. Case's CPT 116 . S Y="" 117 . ; Order of CPT5/4/3 is important for the algorithm, which 118 . ; uses the 1st rule found at the LOWEST level of detail defined 119 . F X=CPT5,CPT4,CPT3 I $D(^MAG(2006.65,"B",X)) S Y=Y_$S(Y:",",1:"")_X S $P(MAGMATCH,U)=Y 120 I CPT,MAGGRY(0) D 121 . ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's 122 . S HIT=0,CURCPTS=$P(MAGGRY(1),U) 123 . F Q:CURCPTS="" S CURCPTX=$O(^MAG(2006.65,"B",$P(CURCPTS,","),"")) S CURCPTS=$P(CURCPTS,",",2,9) I CURCPTX]"" D Q:HIT ; 1st hit only 124 .. ; This algorithm checks from lowest detail to most general, and acts 125 .. ; on the information found at the FIRST Hit only 126 .. F CPT="CPT5","CPT4","CPT3" S CPT=@CPT I CPT]"",$D(^MAG(2006.65,CURCPTX,1,"B",CPT)) S X=$O(^(CPT,"")) D S HIT=1 Q ;1st hit only 127 ... S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=$S(ACTION="A":2,1:5),X=$P(X,U,Y,Y+2) 128 ... I +X S MAGMATCH=CPT F I=2,3 S $P(MAGMATCH,U,I)=$P(X,U,I) 129 ; sample of logic file: 130 ; ^MAG(2006.65,1,0) = 730 131 ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2 132 ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10 133 ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4 134 ; ^MAG(2006.65,1,1,"B",730,1) = 135 ; ^MAG(2006.65,1,1,"B",732,2) = 136 ; ^MAG(2006.65,"B",730,1) = 137 ; 138 Q:'MAGMATCH 139 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM 140 ; 6 RADATE RADTE RACN RAPRC RARPT 141 ; 11 RAST DAYCASE RAELOC RASTP RASTORD 142 ; 16 RADTPRT RACPT RAIMGTYP 143 S MAGDTH=$$FMTH^XLFDT($P(RADATA,U,7),1) 144 S X=$P(RADATA,U,18) 145 S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X) 146 S Y=MAGGRY(0)+1,$P(MAGGRY(0),U)=Y,MAGGRY(Y)=MAGMATCH_U_MAGDTH_U_U_$P(RADATA,U,9)_U_RAIMGTYP_U_RADFN_U_RADTI_U_RACNI_U_RARPT_U_$P(RADATA,U,12)_U_$P(RADATA,U,11) 147 Q 148 ; 149 SVMAG2B ; For exams whose CPTs match, select a subset that are within defined 150 ; limits with respect to time interval & maximum # exams to retrieve 151 ; Return MAGGRY(0) = count ^ message 152 ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT 153 N CPT,CT,CURDAT,ICPT,IREC,GO 154 S CURDAT=$P(MAGGRY(1),U,4) 155 F IREC=2:1:MAGGRY(0) S X=MAGGRY(IREC),CPT=+X D K MAGGRY(IREC) 156 . I $P(X,U,2) S Y=CURDAT-$P(X,U,4) S:Y<0 Y=-Y I Y>$P(X,U,2) Q ;too old 157 . S Y=$G(GO(CPT))+1 I CPT,(Y>$P(X,U,3)) Q ; already have enough cases 158 . S GO(CPT)=Y,GO(CPT,Y)=X 159 K MAGGRY 160 I $D(GO) S CT=0,CPT="" D 161 . F S CPT=$O(GO(CPT)) Q:CPT="" F ICPT=1:1:GO(CPT) D 162 .. S CT=CT+1,X=GO(CPT,ICPT),RARPT=$P(X,U,11) 163 .. S MAGGRY(CT)="M08^"_CPT_"|"_$P(X,U,8,11) 164 .. I ACTION="P"!(ACTION="A") S Y=$$JBFETCH^MAGJUTL2(RARPT) ; fetch from jukebox 165 . S MAGGRY(0)=CT_"^"_HDR 166 E S MAGGRY(0)="0^No Exams Found for "_HDR 167 Q 168 ; 169 END ; 1 MAGJEX2 ;;WIRMFO/JHC Rad. Workstation RPC calls;[ 02/25/2000 4:40 PM ] ; 09 Jun 2003 2:58 PM 2 ;;3.0;IMAGING;**51,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 pre-fetch/ auto-display prior exams' images 20 ; Entry Points: 21 ; PRIOR1 -- Pre-Fetch/Auto-Display images for other related cases; 22 ; RPC Call: MAGJ PRIOREXAMS 23 ; PREFETCH -- Pre-Fetch initiated from 24 ; 25 Q 26 ERR N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^Server Program Error: "_ERR 27 D @^%ZOSF("ERRTN") 28 Q:$Q 1 Q 29 PREFETCH ; Entry point from HL7 processing, to initiate prefetch at 30 ; time of radiology "Register Patient for Exam" function 31 ; Do not process if the exam is being Canceled (RACANC true) 32 ; 33 N RET S RET="" 34 I '$P($G(^MAG(2006.69,1,0)),U,5) G PREFQ ; Prefetch disabled 35 I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) G PREFQ ; Required vars 36 D PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI) 37 PREFQ ; W !,"End PRE-FETCH RET=" N JHC R JHC ZW RET 38 Q 39 ; 40 PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams 41 ; This ep also called as subroutine from routing software (P51) 42 ; MAGGRY - return array of exams to PreFetch, or Auto-send to RAD W/S 43 ; DATA: - input params for the Current Exam 44 ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk) 45 ; = A -- Auto-route priors 46 ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file 47 ; 3) RADTI = "" "" "" "" 48 ; 4) RACNI = "" "" "" "" 49 ; 5) RARPT - Case pointer to ^RARPT global 50 ; 51 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX2" 52 K MAGGRY 53 N RADFN,RADTI,RACNI,RARPT,RADATA 54 N DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT 55 S ACTION=$P(DATA,U) 56 I ACTION="P"!(ACTION="A") 57 E S MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")" G PRIOR1Z 58 S MAGDFN=$P(DATA,U,2),MAGDTI=$P(DATA,U,3),MAGCNI=$P(DATA,U,4) 59 I MAGDFN,MAGDTI,MAGCNI 60 E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")" G PRIOR1Z 61 S DIQUIET=1 D DT^DICRW 62 N MAGJOB D MAGJOBNC^MAGJUTL3 63 S HDR=$S(ACTION="P":"Pre-fetch",ACTION="A":"Auto-Display",1:"???")_" Prior Exams for CASE: " 64 I '$D(^DPT(MAGDFN,0)) S MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")" G PRIOR1Z 65 I $D(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI)) 66 E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")" G PRIOR1Z 67 S MAGRACNT=0 68 S MAGGRY(0)="0^Compiling Prior Radiology Exams" 69 D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) ; Current Exam only 70 S RADFN=MAGDFN,RADTI=MAGDTI,RACNI=MAGCNI 71 I 'MAGRET S MAGGRY(0)="0^Current Case is Not Accessible" G PRIOR1Z 72 S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) S DAYCASE=$P(RADATA,U,12) D SVMAG2A 73 I 'MAGGRY(0) S MAGGRY(0)="0^Current Case either has no CPT code, or has no rules defined for its CPT code." G PRIOR1Z 74 S HDR=HDR_DAYCASE 75 D SRCH(MAGDFN) ; Search prior exams for this patient 76 PRIOR1Z ; 77 I 'MAGGRY(0) S:(MAGGRY(0)["Compiling") MAGGRY(0)="0^No Exams Found" 78 E I +MAGGRY(0)=1 S MAGGRY(0)="0^No Prior Exams Found" K MAGGRY(1) 79 E D SVMAG2B 80 K ^TMP($J,"MAGRAEX"),^("RAE1") 81 Q 82 ; 83 SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total 84 ; numbers of exams to consider 85 N BEGDT,LIMYRS,LIMEXAMS,X 86 S X=$G(^MAG(2006.69,1,0)) 87 S LIMYRS=+$P(X,U,14),LIMEXAMS=+$P(X,U,15) 88 S:'LIMYRS LIMYRS=10 S:'LIMEXAMS LIMEXAMS=100 ; default limit # Exams 89 S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7) 90 I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS 91 S MAGRACNT=1 D GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS) 92 I MAGRET N IDAT S IDAT=1 D 93 . F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT S RADATA=^(IDAT,1) D 94 .. S RADTI=$P(RADATA,U,2),RACNI=$P(RADATA,U,3) 95 .. I RADTI=MAGDTI&(RACNI=MAGCNI) Q ; skip current case 96 .. D SVMAG2A 97 Q 98 ; 99 SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1 100 ; Find all the patient's exams whose CPT codes are related to the 101 ; Current exam's CPT code, according to dictionary 2006.65 102 N RAIMGTYP 103 N CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH 104 S RARPT=+$P(RADATA,U,10) 105 I MAGGRY(0) Q:'$P(MAGGRY(1),U) ; Cur Case CPT not in map file 106 I Q:(ACTION="P")&'$D(^RARPT(RARPT,2005)) ; nothing to pre-fetch 107 I Q:$P(RADATA,U,15)<2 ; Cancel or Waiting 108 ; Note: if no images, may still want to do Auto-Disp to get Report; 109 ; also, Current Case should still proceed 110 S CPT=$P(RADATA,U,17) 111 Q:'CPT ; algorithm REQUIRES CPT codes be used 112 S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3) 113 S MAGMATCH="^^" 114 I 'MAGGRY(0) D Q:'MAGMATCH ; No rules defined for Cur. Case's CPT 115 . S Y="" 116 . ; Order of CPT5/4/3 is important for the algorithm, which 117 . ; uses the 1st rule found at the LOWEST level of detail defined 118 . F X=CPT5,CPT4,CPT3 I $D(^MAG(2006.65,"B",X)) S Y=Y_$S(Y:",",1:"")_X S $P(MAGMATCH,U)=Y 119 I CPT,MAGGRY(0) D 120 . ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's 121 . S HIT=0,CURCPTS=$P(MAGGRY(1),U) 122 . F Q:CURCPTS="" S CURCPTX=$O(^MAG(2006.65,"B",$P(CURCPTS,","),"")) S CURCPTS=$P(CURCPTS,",",2,9) I CURCPTX]"" D Q:HIT ; 1st hit only 123 .. ; This algorithm checks from lowest detail to most general, and acts 124 .. ; on the information found at the FIRST Hit only 125 .. F CPT="CPT5","CPT4","CPT3" S CPT=@CPT I CPT]"",$D(^MAG(2006.65,CURCPTX,1,"B",CPT)) S X=$O(^(CPT,"")) D S HIT=1 Q ;1st hit only 126 ... S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=$S(ACTION="A":2,1:5),X=$P(X,U,Y,Y+2) 127 ... I +X S MAGMATCH=CPT F I=2,3 S $P(MAGMATCH,U,I)=$P(X,U,I) 128 ; sample of logic file: 129 ; ^MAG(2006.65,1,0) = 730 130 ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2 131 ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10 132 ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4 133 ; ^MAG(2006.65,1,1,"B",730,1) = 134 ; ^MAG(2006.65,1,1,"B",732,2) = 135 ; ^MAG(2006.65,"B",730,1) = 136 ; 137 Q:'MAGMATCH 138 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM 139 ; 6 RADATE RADTE RACN RAPRC RARPT 140 ; 11 RAST DAYCASE RAELOC RASTP RASTORD 141 ; 16 RADTPRT RACPT RAIMGTYP 142 S X=$P(RADATA,U,7) D H^%DTC S MAGDTH=+%H 143 S X=$P(RADATA,U,18) 144 S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X) 145 S Y=MAGGRY(0)+1,$P(MAGGRY(0),U)=Y,MAGGRY(Y)=MAGMATCH_U_MAGDTH_U_U_$P(RADATA,U,9)_U_RAIMGTYP_U_RADFN_U_RADTI_U_RACNI_U_RARPT_U_$P(RADATA,U,12)_U_$P(RADATA,U,11) 146 Q 147 ; 148 SVMAG2B ; For exams whose CPTs match, select a subset that are within defined 149 ; limits with respect to time interval & maximum # exams to retrieve 150 ; Return MAGGRY(0) = count ^ message 151 ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT 152 N CPT,CT,CURDAT,ICPT,IREC,GO 153 S CURDAT=$P(MAGGRY(1),U,4) 154 F IREC=2:1:MAGGRY(0) S X=MAGGRY(IREC),CPT=+X D K MAGGRY(IREC) 155 . I $P(X,U,2) S Y=CURDAT-$P(X,U,4) S:Y<0 Y=-Y I Y>$P(X,U,2) Q ;too old 156 . S Y=$G(GO(CPT))+1 I CPT,(Y>$P(X,U,3)) Q ; already have enough cases 157 . S GO(CPT)=Y,GO(CPT,Y)=X 158 K MAGGRY 159 I $D(GO) S CT=0,CPT="" D 160 . F S CPT=$O(GO(CPT)) Q:CPT="" F ICPT=1:1:GO(CPT) D 161 .. S CT=CT+1,X=GO(CPT,ICPT),RARPT=$P(X,U,11) 162 .. S MAGGRY(CT)="M08^"_CPT_"|"_$P(X,U,8,11) 163 .. I ACTION="P"!(ACTION="A") S Y=$$JBFETCH^MAGJUTL2(RARPT) ; fetch from jukebox 164 . S MAGGRY(0)=CT_"^"_HDR 165 E S MAGGRY(0)="0^No Exams Found for "_HDR 166 Q 167 ; 168 END ;
Note:
See TracChangeset
for help on using the changeset viewer.
