MAGNUTL2 ;OIT/NST - VistRad subroutines for RPC calls ; NOV 19, 2018@1:42PM
;;3.0;IMAGING;**201,221,365**;Dec 02, 2009;Build 19
;;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. |
;; +---------------------------------------------------------------+
;;
Q
;
; Subroutines for pre-cache exams images
; Entry Points:
; PRECACHE -- Subroutine call via Protocol trigger
;
PRECACHE ; Entry point from HL7 processing, to initiate precache at
; time of radiology "Register Patient for Exam" RA REG protocol
; ZEXCEPT: RACANC,RADFN,RADTI,RACNI ;Set by calling code for assumption
;
;*zeb *365 transition to new precache settings
Q:$G(RACANC) ;abort if exam is being canceled
Q:'($G(RADFN)&$G(RADTI)&$G(RACNI)) ;abort if required variables not present
N ABORT,MAGRET,MAGDATA,MAGCPT,ALLCPTS,CPTIENS
S ABORT=1
K ^TMP($J,"MAGRAEX")
D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET) ; Get Exam Data
S MAGDATA=$G(^TMP($J,"MAGRAEX",1,1))
K ^TMP($J,"MAGRAEX")
S MAGCPT=$P(MAGDATA,U,17)
S ALLCPTS=$$ALLCPTS()
Q:(MAGCPT=""&'ALLCPTS) ;Abort if CPT code is required and not found
S:ALLCPTS ABORT=0
I ABORT D
. S CPTIENS=$$CPTIENS^MAGNUTL3(MAGCPT)
. Q:CPTIENS=-1
. S:$$GET1^DIQ(2006.14,CPTIENS,2,"I") ABORT=0
Q:ABORT
;
N RET S RET=""
; MAGJEX2 will call CACHE^MAGNUTL2 after collecting all images to be precached - "C" is a new action
D PRIOR1^MAGJEX2(.RET,"C"_U_RADFN_U_RADTI_U_RACNI)
D CPTWI(RADFN,RADTI,RACNI,MAGDATA) ; create work item with CPT code and patient treating facilities
Q
;
CACHE(RARPT) ; cache this case's images
; Input: RARPT: IEN in RAD/NUC MED REPORTS file (#74)
;
N MAGOUT
D NWRKITEM(.MAGOUT,RARPT)
Q 1
;
NWRKITEM(MAGOUT,RARPT) ;Create New MAG WORK ITEM
; RARPT - IEN in RAD/NUC MED REPORTS file (#74)
;
N CRTUSR,CRTAPP,DFN,ICN,J,MAGCTXID,MSGTAGS,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,SSEP
;
S SSEP="`"
S MAGCTXID=$$RACPRS^MAGNU003(RARPT) ; Radiology CPRS context
I MAGCTXID="" S MAGOUT=-20_SSEP_"CPRS context is blank"
S DFN=$$GET1^DIQ(74,RARPT,2,"I")
;
S PLACEID=DUZ(2)
;
; TAGS
S J=0
S J=J+1,MSGTAGS(J)="contextID`"_$TR(MAGCTXID,"^","~") ;CPRS Report Context ID and translate ^ to ~
S:DFN J=J+1,MSGTAGS(J)="patientDfn`"_DFN
I $L($T(GETICN^MPIF001)) D
. S ICN=$$GETICN^MPIF001(DFN)
. S:ICN>1 J=J+1,MSGTAGS(J)="patientIcn`"_ICN
. Q
S J=J+1,MSGTAGS(J)="registration`1" ; precache flag
;
S TYPE="PRECACHE"
S SUBTYPE="REGISTRATION"
S STATUS="New"
S PRIORITY=0
;
S PLACEID=$$STA^XUAF4(PLACEID) ;IA # 2171
;
S CRTUSR=DUZ ; CREATED BY
;
S CRTAPP="PRECACHE" ; CAPTURE APPLICATION
;
D CRTITEM^MAGVIM01(.MAGOUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
Q
;
;*zeb *365 allow MAGDATA to be passed in if it was loaded earlier
CPTWI(RADFN,RADTI,RACNI,MAGDATA) ; create work item with CPT code and patient treating facilities
N MAGCPT,MAGI,MAGOUT,MAGRET
N CRTUSR,CRTAPP,ICN,J,MSGTAGS,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,SSEP
;
I '$G(MAGDATA) D
. K ^TMP($J,"MAGRAEX")
. D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET) ; Get Exam Data
. S MAGDATA=$G(^TMP($J,"MAGRAEX",1,1))
. K ^TMP($J,"MAGRAEX")
S MAGCPT=$P(MAGDATA,U,17)
I 'MAGCPT Q ; No CPT code found
;
; Get treating facilities
D FACLIST^MAGJLST1(.MAGOUT,RADFN)
I MAGOUT(0)'>0 Q ; No treating facilities found
;
S SSEP="`"
S PLACEID=DUZ(2)
;
; TAGS
S J=0
S J=J+1,MSGTAGS(J)="patientDfn`"_RADFN
I $L($T(GETICN^MPIF001)) D
. S ICN=$$GETICN^MPIF001(RADFN)
. S:ICN>1 J=J+1,MSGTAGS(J)="patientIcn`"_ICN
. Q
;
S MAGI=0
F S MAGI=$O(MAGOUT(MAGI)) Q:'MAGI D
. S J=J+1,MSGTAGS(J)="treatingStation"_MAGI_"`"_$P(MAGOUT(MAGI),"^")
. Q
;
S J=J+1,MSGTAGS(J)="CPT`"_MAGCPT
S J=J+1,MSGTAGS(J)="remoteprior`1" ; precache flag
;
S TYPE="PRECACHE"
S SUBTYPE="REMOTEPRIOR"
S STATUS="New"
S PRIORITY=0
;
S PLACEID=$$STA^XUAF4(PLACEID) ;IA # 2171
;
S CRTUSR=DUZ ; CREATED BY
;
S CRTAPP="PRECACHE"
;
D CRTITEM^MAGVIM01(.MAGOUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
Q
;
GCPRSID(RARPT) ; return SITE, ICN, CPRSContextID
N DFN,ICN,MAGCTXID,PLACEID
;
S MAGCTXID=$$RACPRS^MAGNU003(RARPT) ; Radiology CPRS context
I MAGCTXID="" Q ""
S DFN=$$GET1^DIQ(74,RARPT,2,"I")
;
S PLACEID=$$STA^XUAF4(DUZ(2)) ;IA # 2171
;
S ICN=""
S:$L($T(GETICN^MPIF001)) ICN=$$GETICN^MPIF001(DFN)
Q PLACEID_"^"_DFN_"^"_ICN_"^"_$TR(MAGCTXID,"^","~")
;
;*zeb *365 added for new settings
ALLCPTS() ;Returns value of PRECACHE ON RAD EXAM REG field (#351) from IMAGING SITE PARAMETERS (#2006.1) entry for user's division
;Returns "" if unable to find correct site params
N ISPIEN
S ISPIEN=$O(^MAG(2006.1,"B",$$STA^XUAF4(DUZ(2)),""))
Q:ISPIEN="" ""
Q $$GET1^DIQ(2006.1,ISPIEN_",",351,"I")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNUTL2 5774 printed May 25, 2026@12:11:38 Page 2
MAGNUTL2 ;OIT/NST - VistRad subroutines for RPC calls ; NOV 19, 2018@1:42PM
+1 ;;3.0;IMAGING;**201,221,365**;Dec 02, 2009;Build 19
+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 ;; | |
+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 QUIT
+19 ;
+20 ; Subroutines for pre-cache exams images
+21 ; Entry Points:
+22 ; PRECACHE -- Subroutine call via Protocol trigger
+23 ;
PRECACHE ; Entry point from HL7 processing, to initiate precache at
+1 ; time of radiology "Register Patient for Exam" RA REG protocol
+2 ; ZEXCEPT: RACANC,RADFN,RADTI,RACNI ;Set by calling code for assumption
+3 ;
+4 ;*zeb *365 transition to new precache settings
+5 ;abort if exam is being canceled
if $GET(RACANC)
QUIT
+6 ;abort if required variables not present
if '($GET(RADFN)&$GET(RADTI)&$GET(RACNI))
QUIT
+7 NEW ABORT,MAGRET,MAGDATA,MAGCPT,ALLCPTS,CPTIENS
+8 SET ABORT=1
+9 KILL ^TMP($JOB,"MAGRAEX")
+10 ; Get Exam Data
DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
+11 SET MAGDATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
+12 KILL ^TMP($JOB,"MAGRAEX")
+13 SET MAGCPT=$PIECE(MAGDATA,U,17)
+14 SET ALLCPTS=$$ALLCPTS()
+15 ;Abort if CPT code is required and not found
if (MAGCPT=""&'ALLCPTS)
QUIT
+16 if ALLCPTS
SET ABORT=0
+17 IF ABORT
Begin DoDot:1
+18 SET CPTIENS=$$CPTIENS^MAGNUTL3(MAGCPT)
+19 if CPTIENS=-1
QUIT
+20 if $$GET1^DIQ(2006.14,CPTIENS,2,"I")
SET ABORT=0
End DoDot:1
+21 if ABORT
QUIT
+22 ;
+23 NEW RET
SET RET=""
+24 ; MAGJEX2 will call CACHE^MAGNUTL2 after collecting all images to be precached - "C" is a new action
+25 DO PRIOR1^MAGJEX2(.RET,"C"_U_RADFN_U_RADTI_U_RACNI)
+26 ; create work item with CPT code and patient treating facilities
DO CPTWI(RADFN,RADTI,RACNI,MAGDATA)
+27 QUIT
+28 ;
CACHE(RARPT) ; cache this case's images
+1 ; Input: RARPT: IEN in RAD/NUC MED REPORTS file (#74)
+2 ;
+3 NEW MAGOUT
+4 DO NWRKITEM(.MAGOUT,RARPT)
+5 QUIT 1
+6 ;
NWRKITEM(MAGOUT,RARPT) ;Create New MAG WORK ITEM
+1 ; RARPT - IEN in RAD/NUC MED REPORTS file (#74)
+2 ;
+3 NEW CRTUSR,CRTAPP,DFN,ICN,J,MAGCTXID,MSGTAGS,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,SSEP
+4 ;
+5 SET SSEP="`"
+6 ; Radiology CPRS context
SET MAGCTXID=$$RACPRS^MAGNU003(RARPT)
+7 IF MAGCTXID=""
SET MAGOUT=-20_SSEP_"CPRS context is blank"
+8 SET DFN=$$GET1^DIQ(74,RARPT,2,"I")
+9 ;
+10 SET PLACEID=DUZ(2)
+11 ;
+12 ; TAGS
+13 SET J=0
+14 ;CPRS Report Context ID and translate ^ to ~
SET J=J+1
SET MSGTAGS(J)="contextID`"_$TRANSLATE(MAGCTXID,"^","~")
+15 if DFN
SET J=J+1
SET MSGTAGS(J)="patientDfn`"_DFN
+16 IF $LENGTH($TEXT(GETICN^MPIF001))
Begin DoDot:1
+17 SET ICN=$$GETICN^MPIF001(DFN)
+18 if ICN>1
SET J=J+1
SET MSGTAGS(J)="patientIcn`"_ICN
+19 QUIT
End DoDot:1
+20 ; precache flag
SET J=J+1
SET MSGTAGS(J)="registration`1"
+21 ;
+22 SET TYPE="PRECACHE"
+23 SET SUBTYPE="REGISTRATION"
+24 SET STATUS="New"
+25 SET PRIORITY=0
+26 ;
+27 ;IA # 2171
SET PLACEID=$$STA^XUAF4(PLACEID)
+28 ;
+29 ; CREATED BY
SET CRTUSR=DUZ
+30 ;
+31 ; CAPTURE APPLICATION
SET CRTAPP="PRECACHE"
+32 ;
+33 DO CRTITEM^MAGVIM01(.MAGOUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
+34 QUIT
+35 ;
+36 ;*zeb *365 allow MAGDATA to be passed in if it was loaded earlier
CPTWI(RADFN,RADTI,RACNI,MAGDATA) ; create work item with CPT code and patient treating facilities
+1 NEW MAGCPT,MAGI,MAGOUT,MAGRET
+2 NEW CRTUSR,CRTAPP,ICN,J,MSGTAGS,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,SSEP
+3 ;
+4 IF '$GET(MAGDATA)
Begin DoDot:1
+5 KILL ^TMP($JOB,"MAGRAEX")
+6 ; Get Exam Data
DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
+7 SET MAGDATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
+8 KILL ^TMP($JOB,"MAGRAEX")
End DoDot:1
+9 SET MAGCPT=$PIECE(MAGDATA,U,17)
+10 ; No CPT code found
IF 'MAGCPT
QUIT
+11 ;
+12 ; Get treating facilities
+13 DO FACLIST^MAGJLST1(.MAGOUT,RADFN)
+14 ; No treating facilities found
IF MAGOUT(0)'>0
QUIT
+15 ;
+16 SET SSEP="`"
+17 SET PLACEID=DUZ(2)
+18 ;
+19 ; TAGS
+20 SET J=0
+21 SET J=J+1
SET MSGTAGS(J)="patientDfn`"_RADFN
+22 IF $LENGTH($TEXT(GETICN^MPIF001))
Begin DoDot:1
+23 SET ICN=$$GETICN^MPIF001(RADFN)
+24 if ICN>1
SET J=J+1
SET MSGTAGS(J)="patientIcn`"_ICN
+25 QUIT
End DoDot:1
+26 ;
+27 SET MAGI=0
+28 FOR
SET MAGI=$ORDER(MAGOUT(MAGI))
if 'MAGI
QUIT
Begin DoDot:1
+29 SET J=J+1
SET MSGTAGS(J)="treatingStation"_MAGI_"`"_$PIECE(MAGOUT(MAGI),"^")
+30 QUIT
End DoDot:1
+31 ;
+32 SET J=J+1
SET MSGTAGS(J)="CPT`"_MAGCPT
+33 ; precache flag
SET J=J+1
SET MSGTAGS(J)="remoteprior`1"
+34 ;
+35 SET TYPE="PRECACHE"
+36 SET SUBTYPE="REMOTEPRIOR"
+37 SET STATUS="New"
+38 SET PRIORITY=0
+39 ;
+40 ;IA # 2171
SET PLACEID=$$STA^XUAF4(PLACEID)
+41 ;
+42 ; CREATED BY
SET CRTUSR=DUZ
+43 ;
+44 SET CRTAPP="PRECACHE"
+45 ;
+46 DO CRTITEM^MAGVIM01(.MAGOUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
+47 QUIT
+48 ;
GCPRSID(RARPT) ; return SITE, ICN, CPRSContextID
+1 NEW DFN,ICN,MAGCTXID,PLACEID
+2 ;
+3 ; Radiology CPRS context
SET MAGCTXID=$$RACPRS^MAGNU003(RARPT)
+4 IF MAGCTXID=""
QUIT ""
+5 SET DFN=$$GET1^DIQ(74,RARPT,2,"I")
+6 ;
+7 ;IA # 2171
SET PLACEID=$$STA^XUAF4(DUZ(2))
+8 ;
+9 SET ICN=""
+10 if $LENGTH($TEXT(GETICN^MPIF001))
SET ICN=$$GETICN^MPIF001(DFN)
+11 QUIT PLACEID_"^"_DFN_"^"_ICN_"^"_$TRANSLATE(MAGCTXID,"^","~")
+12 ;
+13 ;*zeb *365 added for new settings
ALLCPTS() ;Returns value of PRECACHE ON RAD EXAM REG field (#351) from IMAGING SITE PARAMETERS (#2006.1) entry for user's division
+1 ;Returns "" if unable to find correct site params
+2 NEW ISPIEN
+3 SET ISPIEN=$ORDER(^MAG(2006.1,"B",$$STA^XUAF4(DUZ(2)),""))
+4 if ISPIEN=""
QUIT ""
+5 QUIT $$GET1^DIQ(2006.1,ISPIEN_",",351,"I")
+6 ;
