- MAGJEX2 ;WIRMFO/JHC,NST - Rad. Workstation RPC calls ; 10/17/2022
- ;;3.0;IMAGING;**51,18,76,120,201,341**;Dec 21, 2022;Build 28
- ;; Per VHA Directive 2004-038, this routine should not be modified.
- ;; +---------------------------------------------------------------+
- ;; | Property of the US Government. |
- ;; | No permission to copy or redistribute this software is given. |
- ;; | Use of unreleased versions of this software requires the user |
- ;; | to execute a written test agreement with the VistA Imaging |
- ;; | Development Office of the Department of Veterans Affairs, |
- ;; | telephone (301) 734-0100. |
- ;; | The Food and Drug Administration classifies this software as |
- ;; | a medical device. As such, it may not be changed in any way. |
- ;; | Modifications to this software may result in an adulterated |
- ;; | medical device under 21CFR820, the use of which is considered |
- ;; | to be a violation of US Federal Statutes. |
- ;; +---------------------------------------------------------------+
- ;;
- ;; ISI IMAGING;**99,106**
- Q
- ; Subroutines for pre-fetch/ auto-route prior exams' images
- ; Entry Points:
- ; PRIOR1 -- Pre-Fetch/Auto-route images for other related cases;
- ; RPC Call: MAGJ PRIOREXAMS
- ; PREFETCH -- Subroutine call via Protocol trigger
- ;
- Q
- ERR N ERR S ERR=$$EC^%ZOSV S MAGGRY(0)="0^Server Program Error: "_ERR
- D @^%ZOSF("ERRTN")
- Q:$Q 1 Q
- PREFETCH ; Entry point from HL7 processing, to initiate prefetch at
- ; time of radiology "Register Patient for Exam" function
- ; Do not process if the exam is being Canceled (RACANC true)
- ;
- N RET S RET=""
- I '$P($G(^MAG(2006.69,1,0)),U,5) G PREFQ ; Prefetch disabled
- I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) G PREFQ ; Required vars
- D PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI)
- PREFQ ;
- Q
- ;
- PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams
- ; This ep also called as subroutine from routing software (P51)
- ; MAGGRY - return array of exams to PreFetch or Auto-route
- ; DATA: - input params for the Current Exam
- ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk)
- ; = A -- Auto-route priors
- ; = C -- Pre-cache exams
- ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file
- ; 3) RADTI = "" "" "" ""
- ; 4) RACNI = "" "" "" ""
- ; 5) RARPT - Case pointer to ^RARPT global
- ;
- N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX2"
- K MAGGRY
- N RADFN,RADTI,RACNI,RARPT,RADATA,RADATA2 ; ISI P106
- N DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT
- S ACTION=$P(DATA,U)
- I ACTION="P"!(ACTION="A")!(ACTION="C")!(ACTION="ISIP") ; ISI new prefetch action ISIP
- E S MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")" G PRIOR1Z
- S MAGDFN=$P(DATA,U,2),MAGDTI=$P(DATA,U,3),MAGCNI=$P(DATA,U,4)
- I MAGDFN,MAGDTI,MAGCNI
- E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")" G PRIOR1Z
- S DIQUIET=1 D DT^DICRW
- N MAGJOB D MAGJOBNC^MAGJUTL3
- S HDR=$S(ACTION="P":"Pre-fetch",ACTION="A":"Auto-route",ACTION="C":"Pre-cache",1:"???")_" Prior Exams for CASE: "
- I '$D(^DPT(MAGDFN,0)) S MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")" G PRIOR1Z
- I $D(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI))
- E S MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")" G PRIOR1Z
- S MAGRACNT=0
- S MAGGRY(0)="0^Compiling Prior Radiology Exams"
- D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET) ; Current Exam only
- S RADFN=MAGDFN,RADTI=MAGDTI,RACNI=MAGCNI
- I 'MAGRET S MAGGRY(0)="0^Current Case is Not Accessible" G PRIOR1Z
- S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)),DAYCASE=$P(RADATA,U,12) D SVMAG2A ; ISI P106
- 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
- S HDR=HDR_DAYCASE
- D SRCH(MAGDFN) ; Search prior exams for this patient
- PRIOR1Z ;
- I 'MAGGRY(0) S:(MAGGRY(0)["Compiling") MAGGRY(0)="0^No Exams Found"
- E I +MAGGRY(0)=1 S MAGGRY(0)="0^No Prior Exams Found" K MAGGRY(1)
- E D SVMAG2B
- K ^TMP($J,"MAGRAEX"),^("RAE1")
- Q
- ;
- SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total
- ; numbers of exams to consider
- N BEGDT,LIMYRS,LIMEXAMS
- S LIMYRS=30,LIMEXAMS=100 ; default limit # Exams
- S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7)
- I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS
- S MAGRACNT=1 D GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS)
- I MAGRET N IDAT S IDAT=1 D
- . F S IDAT=$O(^TMP($J,"MAGRAEX",IDAT)) Q:'IDAT S RADATA=^(IDAT,1),RADATA2=$G(^(2)) D ; ISI P106
- . . S RADTI=$P(RADATA,U,2),RACNI=$P(RADATA,U,3)
- . . I RADTI=MAGDTI&(RACNI=MAGCNI) Q ; skip current case
- . . D SVMAG2A
- Q
- ;
- SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1
- ; Find all the patient's exams whose CPT codes are related to the
- ; Current exam's CPT code, according to dictionary 2006.65
- N RAIMGTYP,X,RASTCAT ; ISI P106
- N CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH,I
- S RARPT=+$P(RADATA,U,10)
- S RASTCAT=$P(RADATA2,U,11) ; ISI P106
- I MAGGRY(0) Q:'$P(MAGGRY(1),U) ; Cur Case CPT not in map file
- I Q:(ACTION="P")&'$D(^RARPT(RARPT,2005)) ; nothing to pre-fetch
- I Q:$P(RADATA,U,15)<2!(RASTCAT="R") ; Cancel or Waiting ; or Ready for Interp ISI P106
- ; Note: if no images, may still want to do Auto-Disp to get Report;
- ; also, Current Case should still proceed
- S CPT=$P(RADATA,U,17)
- Q:'CPT ; algorithm REQUIRES CPT codes be used
- S CPT5=CPT,CPT4=$E(CPT,1,4),CPT3=$E(CPT,1,3)
- S MAGMATCH="^^"
- I 'MAGGRY(0) D Q:'MAGMATCH ; No rules defined for Cur. Case's CPT
- . S Y=""
- . ; Order of CPT5/4/3 is important for the algorithm, which
- . ; uses the 1st rule found at the LOWEST level of detail defined
- . F X=CPT5,CPT4,CPT3 I $D(^MAG(2006.65,"B",X)) S Y=Y_$S(Y:",",1:"")_X S $P(MAGMATCH,U)=Y
- I CPT,MAGGRY(0) D
- . ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's
- . S HIT=0,CURCPTS=$P(MAGGRY(1),U)
- . 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
- . . ; This algorithm checks from lowest detail to most general, and acts
- . . ; on the information found at the FIRST Hit only
- . . 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
- . . . S X=^MAG(2006.65,CURCPTX,1,X,0) S Y=$S(ACTION="A":2,1:5),X=$P(X,U,Y,Y+2)
- . . . I +X S MAGMATCH=CPT F I=2,3 S $P(MAGMATCH,U,I)=$P(X,U,I)
- ; sample of logic file:
- ; ^MAG(2006.65,1,0) = 730
- ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2
- ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10
- ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4
- ; ^MAG(2006.65,1,1,"B",730,1) =
- ; ^MAG(2006.65,1,1,"B",732,2) =
- ; ^MAG(2006.65,"B",730,1) =
- ;
- Q:'MAGMATCH
- ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
- ; 6 RADATE RADTE RACN RAPRC RARPT
- ; 11 RAST DAYCASE RAELOC RASTP RASTORD
- ; 16 RADTPRT RACPT RAIMGTYP
- S MAGDTH=$$FMTH^XLFDT($P(RADATA,U,7),1)
- S X=$P(RADATA,U,18)
- S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X)
- 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)
- Q
- ;
- SVMAG2B ; For exams whose CPTs match, select a subset that are within defined
- ; limits with respect to time interval & maximum # exams to retrieve
- ; Return MAGGRY(0) = count ^ message
- ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT
- N CPT,CT,CURDAT,ICPT,IREC,GO,Y
- S CURDAT=$P(MAGGRY(1),U,4)
- F IREC=2:1:MAGGRY(0) S X=MAGGRY(IREC),CPT=+X D K MAGGRY(IREC)
- . 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
- . S Y=$G(GO(CPT))+1 I CPT,(Y>$P(X,U,3)) Q ; already have enough cases
- . S GO(CPT)=Y,GO(CPT,Y)=X
- K MAGGRY
- I $D(GO) S CT=0,CPT="" D
- . F S CPT=$O(GO(CPT)) Q:CPT="" F ICPT=1:1:GO(CPT) D
- . . S CT=CT+1,X=GO(CPT,ICPT),RARPT=$P(X,U,11)
- . . S MAGGRY(CT)="M08^"_CPT_"|"_$P(X,U,8,11)
- . . I ACTION="P"!(ACTION="A") S Y=$$JBFETCH^MAGJUTL2(RARPT) ; fetch from jukebox
- . . I ACTION="C" S Y=$$CACHE^MAGNUTL2(RARPT) ; precache exams
- . . I ACTION="ISIP" S:$T(^ISINUTL2)'="" Y=$$FETCH^ISINUTL2(RARPT) ; ISI -- ISIX pre-fetch
- . S MAGGRY(0)=CT_"^"_HDR
- E S MAGGRY(0)="0^No Exams Found for "_HDR
- Q
- ;
- END ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJEX2 8592 printed Feb 18, 2025@23:33:10 Page 2
- MAGJEX2 ;WIRMFO/JHC,NST - Rad. Workstation RPC calls ; 10/17/2022
- +1 ;;3.0;IMAGING;**51,18,76,120,201,341**;Dec 21, 2022;Build 28
- +2 ;; Per VHA Directive 2004-038, this routine should not be modified.
- +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 ;; | The Food and Drug Administration classifies this software as |
- +11 ;; | a medical device. As such, it may not be changed in any way. |
- +12 ;; | Modifications to this software may result in an adulterated |
- +13 ;; | medical device under 21CFR820, the use of which is considered |
- +14 ;; | to be a violation of US Federal Statutes. |
- +15 ;; +---------------------------------------------------------------+
- +16 ;;
- +17 ;; ISI IMAGING;**99,106**
- +18 QUIT
- +19 ; Subroutines for pre-fetch/ auto-route prior exams' images
- +20 ; Entry Points:
- +21 ; PRIOR1 -- Pre-Fetch/Auto-route images for other related cases;
- +22 ; RPC Call: MAGJ PRIOREXAMS
- +23 ; PREFETCH -- Subroutine call via Protocol trigger
- +24 ;
- +25 QUIT
- ERR NEW ERR
- SET ERR=$$EC^%ZOSV
- SET MAGGRY(0)="0^Server Program Error: "_ERR
- +1 DO @^%ZOSF("ERRTN")
- +2 if $QUIT
- QUIT 1
- QUIT
- PREFETCH ; Entry point from HL7 processing, to initiate prefetch at
- +1 ; time of radiology "Register Patient for Exam" function
- +2 ; Do not process if the exam is being Canceled (RACANC true)
- +3 ;
- +4 NEW RET
- SET RET=""
- +5 ; Prefetch disabled
- IF '$PIECE($GET(^MAG(2006.69,1,0)),U,5)
- GOTO PREFQ
- +6 ; Required vars
- IF '($GET(RADFN)&$GET(RADTI)&$GET(RACNI)&'$GET(RACANC))
- GOTO PREFQ
- +7 DO PRIOR1(.RET,"P"_U_RADFN_U_RADTI_U_RACNI)
- PREFQ ;
- +1 QUIT
- +2 ;
- PRIOR1(MAGGRY,DATA) ; review all exams for a patient to find "related" exams
- +1 ; This ep also called as subroutine from routing software (P51)
- +2 ; MAGGRY - return array of exams to PreFetch or Auto-route
- +3 ; DATA: - input params for the Current Exam
- +4 ; 1) ACTION = P -- Pre-fetch Exams (from Jukebox to Magnetic Disk)
- +5 ; = A -- Auto-route priors
- +6 ; = C -- Pre-cache exams
- +7 ; 2) RADFN = Case pointers to Rad/Nuc Med Patient file
- +8 ; 3) RADTI = "" "" "" ""
- +9 ; 4) RACNI = "" "" "" ""
- +10 ; 5) RARPT - Case pointer to ^RARPT global
- +11 ;
- +12 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERR^MAGJEX2"
- +13 KILL MAGGRY
- +14 ; ISI P106
- NEW RADFN,RADTI,RACNI,RARPT,RADATA,RADATA2
- +15 NEW DAYCASE,DIQUIET,ACTION,CPT,HDR,MAGDFN,MAGDTI,MAGCNI,MAGRET,MAGRACNT
- +16 SET ACTION=$PIECE(DATA,U)
- +17 ; ISI new prefetch action ISIP
- IF ACTION="P"!(ACTION="A")!(ACTION="C")!(ACTION="ISIP")
- +18 IF '$TEST
- SET MAGGRY(0)="0^Invalid Request (Action code="_ACTION_")"
- GOTO PRIOR1Z
- +19 SET MAGDFN=$PIECE(DATA,U,2)
- SET MAGDTI=$PIECE(DATA,U,3)
- SET MAGCNI=$PIECE(DATA,U,4)
- +20 IF MAGDFN
- IF MAGDTI
- IF MAGCNI
- +21 IF '$TEST
- SET MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_DATA_")"
- GOTO PRIOR1Z
- +22 SET DIQUIET=1
- DO DT^DICRW
- +23 NEW MAGJOB
- DO MAGJOBNC^MAGJUTL3
- +24 SET HDR=$SELECT(ACTION="P":"Pre-fetch",ACTION="A":"Auto-route",ACTION="C":"Pre-cache",1:"???")_" Prior Exams for CASE: "
- +25 IF '$DATA(^DPT(MAGDFN,0))
- SET MAGGRY(0)="0^Request Contains Invalid Patient Pointer ("_MAGDFN_")"
- GOTO PRIOR1Z
- +26 IF $DATA(^RADPT(MAGDFN,"DT",MAGDTI,"P",MAGCNI))
- +27 IF '$TEST
- SET MAGGRY(0)="0^Request Contains Invalid Case Pointer ("_MAGCNI_")"
- GOTO PRIOR1Z
- +28 SET MAGRACNT=0
- +29 SET MAGGRY(0)="0^Compiling Prior Radiology Exams"
- +30 ; Current Exam only
- DO GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
- +31 SET RADFN=MAGDFN
- SET RADTI=MAGDTI
- SET RACNI=MAGCNI
- +32 IF 'MAGRET
- SET MAGGRY(0)="0^Current Case is Not Accessible"
- GOTO PRIOR1Z
- +33 ; ISI P106
- SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
- SET RADATA2=$GET(^(2))
- SET DAYCASE=$PIECE(RADATA,U,12)
- DO SVMAG2A
- +34 IF 'MAGGRY(0)
- SET MAGGRY(0)="0^Current Case either has no CPT code, or has no rules defined for its CPT code."
- GOTO PRIOR1Z
- +35 SET HDR=HDR_DAYCASE
- +36 ; Search prior exams for this patient
- DO SRCH(MAGDFN)
- PRIOR1Z ;
- +1 IF 'MAGGRY(0)
- if (MAGGRY(0)["Compiling")
- SET MAGGRY(0)="0^No Exams Found"
- +2 IF '$TEST
- IF +MAGGRY(0)=1
- SET MAGGRY(0)="0^No Prior Exams Found"
- KILL MAGGRY(1)
- +3 IF '$TEST
- DO SVMAG2B
- +4 KILL ^TMP($JOB,"MAGRAEX"),^("RAE1")
- +5 QUIT
- +6 ;
- SRCH(RADFN) ; Traverse all exams for a patient, up to limits of age & total
- +1 ; numbers of exams to consider
- +2 NEW BEGDT,LIMYRS,LIMEXAMS
- +3 ; default limit # Exams
- SET LIMYRS=30
- SET LIMEXAMS=100
- +4 SET BEGDT=($EXTRACT(DT,1,3)-LIMYRS)_$EXTRACT(DT,4,7)
- +5 ; 2 yrs prior to earliest VistaPACS
- IF BEGDT<2950101
- SET BEGDT=2950101
- +6 SET MAGRACNT=1
- DO GETEXAM3^MAGJUTL1(RADFN,BEGDT,"",.MAGRACNT,.MAGRET,"",LIMEXAMS)
- +7 IF MAGRET
- NEW IDAT
- SET IDAT=1
- Begin DoDot:1
- +8 ; ISI P106
- FOR
- SET IDAT=$ORDER(^TMP($JOB,"MAGRAEX",IDAT))
- if 'IDAT
- QUIT
- SET RADATA=^(IDAT,1)
- SET RADATA2=$GET(^(2))
- Begin DoDot:2
- +9 SET RADTI=$PIECE(RADATA,U,2)
- SET RACNI=$PIECE(RADATA,U,3)
- +10 ; skip current case
- IF RADTI=MAGDTI&(RACNI=MAGCNI)
- QUIT
- +11 DO SVMAG2A
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- SVMAG2A ; 2A and 2B used by subroutine at tag PRIOR1
- +1 ; Find all the patient's exams whose CPT codes are related to the
- +2 ; Current exam's CPT code, according to dictionary 2006.65
- +3 ; ISI P106
- NEW RAIMGTYP,X,RASTCAT
- +4 NEW CPT,CPT3,CPT4,CPT5,CURCPTX,CURCPTS,HIT,MAGMATCH,MAGDTH,I
- +5 SET RARPT=+$PIECE(RADATA,U,10)
- +6 ; ISI P106
- SET RASTCAT=$PIECE(RADATA2,U,11)
- +7 ; Cur Case CPT not in map file
- IF MAGGRY(0)
- if '$PIECE(MAGGRY(1),U)
- QUIT
- +8 ; nothing to pre-fetch
- IF $TEST
- if (ACTION="P")&'$DATA(^RARPT(RARPT,2005))
- QUIT
- +9 ; Cancel or Waiting ; or Ready for Interp ISI P106
- IF $TEST
- if $PIECE(RADATA,U,15)<2!(RASTCAT="R")
- QUIT
- +10 ; Note: if no images, may still want to do Auto-Disp to get Report;
- +11 ; also, Current Case should still proceed
- +12 SET CPT=$PIECE(RADATA,U,17)
- +13 ; algorithm REQUIRES CPT codes be used
- if 'CPT
- QUIT
- +14 SET CPT5=CPT
- SET CPT4=$EXTRACT(CPT,1,4)
- SET CPT3=$EXTRACT(CPT,1,3)
- +15 SET MAGMATCH="^^"
- +16 ; No rules defined for Cur. Case's CPT
- IF 'MAGGRY(0)
- Begin DoDot:1
- +17 SET Y=""
- +18 ; Order of CPT5/4/3 is important for the algorithm, which
- +19 ; uses the 1st rule found at the LOWEST level of detail defined
- +20 FOR X=CPT5,CPT4,CPT3
- IF $DATA(^MAG(2006.65,"B",X))
- SET Y=Y_$SELECT(Y:",",1:"")_X
- SET $PIECE(MAGMATCH,U)=Y
- End DoDot:1
- if 'MAGMATCH
- QUIT
- +21 IF CPT
- IF MAGGRY(0)
- Begin DoDot:1
- +22 ; curcpts has the cpt5/4/3 list generated above for Cur. Case CPT's
- +23 SET HIT=0
- SET CURCPTS=$PIECE(MAGGRY(1),U)
- +24 ; 1st hit only
- FOR
- if CURCPTS=""
- QUIT
- SET CURCPTX=$ORDER(^MAG(2006.65,"B",$PIECE(CURCPTS,","),""))
- SET CURCPTS=$PIECE(CURCPTS,",",2,9)
- IF CURCPTX]""
- Begin DoDot:2
- +25 ; This algorithm checks from lowest detail to most general, and acts
- +26 ; on the information found at the FIRST Hit only
- +27 ;1st hit only
- FOR CPT="CPT5","CPT4","CPT3"
- SET CPT=@CPT
- IF CPT]""
- IF $DATA(^MAG(2006.65,CURCPTX,1,"B",CPT))
- SET X=$ORDER(^(CPT,""))
- Begin DoDot:3
- +28 SET X=^MAG(2006.65,CURCPTX,1,X,0)
- SET Y=$SELECT(ACTION="A":2,1:5)
- SET X=$PIECE(X,U,Y,Y+2)
- +29 IF +X
- SET MAGMATCH=CPT
- FOR I=2,3
- SET $PIECE(MAGMATCH,U,I)=$PIECE(X,U,I)
- End DoDot:3
- SET HIT=1
- QUIT
- End DoDot:2
- if HIT
- QUIT
- End DoDot:1
- +30 ; sample of logic file:
- +31 ; ^MAG(2006.65,1,0) = 730
- +32 ; ^MAG(2006.65,1,1,0) = ^12000011.01^2^2
- +33 ; ^MAG(2006.65,1,1,1,0) = 730^1^40^6^1^120^10
- +34 ; ^MAG(2006.65,1,1,2,0) = 732^1^40^2^1^120^4
- +35 ; ^MAG(2006.65,1,1,"B",730,1) =
- +36 ; ^MAG(2006.65,1,1,"B",732,2) =
- +37 ; ^MAG(2006.65,"B",730,1) =
- +38 ;
- +39 if 'MAGMATCH
- QUIT
- +40 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
- +41 ; 6 RADATE RADTE RACN RAPRC RARPT
- +42 ; 11 RAST DAYCASE RAELOC RASTP RASTORD
- +43 ; 16 RADTPRT RACPT RAIMGTYP
- +44 SET MAGDTH=$$FMTH^XLFDT($PIECE(RADATA,U,7),1)
- +45 SET X=$PIECE(RADATA,U,18)
- +46 SET RAIMGTYP=$SELECT(X]"":$ORDER(^RA(79.2,"C",X,"")),1:X)
- +47 SET Y=MAGGRY(0)+1
- SET $PIECE(MAGGRY(0),U)=Y
- SET MAGGRY(Y)=MAGMATCH_U_MAGDTH_U_U_$PIECE(RADATA,U,9)_U_RAIMGTYP_U_RADFN_U_RADTI_U_RACNI_U_RARPT_U_$PIECE(RADATA,U,12)_U_$PIECE(RADATA,U,11)
- +48 QUIT
- +49 ;
- SVMAG2B ; For exams whose CPTs match, select a subset that are within defined
- +1 ; limits with respect to time interval & maximum # exams to retrieve
- +2 ; Return MAGGRY(0) = count ^ message
- +3 ; MAGGRY(1:N) = "M08" | RADFN ^ RADTI ^ RACNI ^ RARPT
- +4 NEW CPT,CT,CURDAT,ICPT,IREC,GO,Y
- +5 SET CURDAT=$PIECE(MAGGRY(1),U,4)
- +6 FOR IREC=2:1:MAGGRY(0)
- SET X=MAGGRY(IREC)
- SET CPT=+X
- Begin DoDot:1
- +7 ;too old
- IF $PIECE(X,U,2)
- SET Y=CURDAT-$PIECE(X,U,4)
- if Y<0
- SET Y=-Y
- IF Y>$PIECE(X,U,2)
- QUIT
- +8 ; already have enough cases
- SET Y=$GET(GO(CPT))+1
- IF CPT
- IF (Y>$PIECE(X,U,3))
- QUIT
- +9 SET GO(CPT)=Y
- SET GO(CPT,Y)=X
- End DoDot:1
- KILL MAGGRY(IREC)
- +10 KILL MAGGRY
- +11 IF $DATA(GO)
- SET CT=0
- SET CPT=""
- Begin DoDot:1
- +12 FOR
- SET CPT=$ORDER(GO(CPT))
- if CPT=""
- QUIT
- FOR ICPT=1:1:GO(CPT)
- Begin DoDot:2
- +13 SET CT=CT+1
- SET X=GO(CPT,ICPT)
- SET RARPT=$PIECE(X,U,11)
- +14 SET MAGGRY(CT)="M08^"_CPT_"|"_$PIECE(X,U,8,11)
- +15 ; fetch from jukebox
- IF ACTION="P"!(ACTION="A")
- SET Y=$$JBFETCH^MAGJUTL2(RARPT)
- +16 ; precache exams
- IF ACTION="C"
- SET Y=$$CACHE^MAGNUTL2(RARPT)
- +17 ; ISI -- ISIX pre-fetch
- IF ACTION="ISIP"
- if $TEXT(^ISINUTL2)'=""
- SET Y=$$FETCH^ISINUTL2(RARPT)
- End DoDot:2
- +18 SET MAGGRY(0)=CT_"^"_HDR
- End DoDot:1
- +19 IF '$TEST
- SET MAGGRY(0)="0^No Exams Found for "_HDR
- +20 QUIT
- +21 ;
- END ;