MAGNUTL2 ;WOIFO/NST - VistRad subroutines for RPC calls ; NOV 19, 2018@1:42PM
;;3.0;IMAGING;**201,221**;Dec 02, 2009;Build 163
;;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
; Do not process if the exam is being Canceled (RACANC true)
;
Q:'$$GET^XPAR("ALL","MAG PRECACHE RAD REG ENABLED",,"I") ; IA# 2263
;
N RET S RET=""
I '($G(RADFN)&$G(RADTI)&$G(RACNI)&'$G(RACANC)) Q ; Required vars
; 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) ; 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
;
CPTWI(RADFN,RADTI,RACNI) ; create work item with CPT code and patient treating facilities
N MAGCPT,MAGDATA,MAGI,MAGOUT,MAGRET
N CRTUSR,CRTAPP,ICN,J,MSGTAGS,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,SSEP
;
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,"^","~")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNUTL2 4785 printed Dec 13, 2024@02:07:32 Page 2
MAGNUTL2 ;WOIFO/NST - VistRad subroutines for RPC calls ; NOV 19, 2018@1:42PM
+1 ;;3.0;IMAGING;**201,221**;Dec 02, 2009;Build 163
+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 ; Do not process if the exam is being Canceled (RACANC true)
+3 ;
+4 ; IA# 2263
if '$$GET^XPAR("ALL","MAG PRECACHE RAD REG ENABLED",,"I")
QUIT
+5 ;
+6 NEW RET
SET RET=""
+7 ; Required vars
IF '($GET(RADFN)&$GET(RADTI)&$GET(RACNI)&'$GET(RACANC))
QUIT
+8 ; MAGJEX2 will call CACHE^MAGNUTL2 after collecting all images to be precached - "C" is a new action
+9 DO PRIOR1^MAGJEX2(.RET,"C"_U_RADFN_U_RADTI_U_RACNI)
+10 ; create work item with CPT code and patient treating facilities
DO CPTWI(RADFN,RADTI,RACNI)
+11 QUIT
+12 ;
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 ;
CPTWI(RADFN,RADTI,RACNI) ; create work item with CPT code and patient treating facilities
+1 NEW MAGCPT,MAGDATA,MAGI,MAGOUT,MAGRET
+2 NEW CRTUSR,CRTAPP,ICN,J,MSGTAGS,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,SSEP
+3 ;
+4 KILL ^TMP($JOB,"MAGRAEX")
+5 ; Get Exam Data
DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
+6 SET MAGDATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
+7 KILL ^TMP($JOB,"MAGRAEX")
+8 SET MAGCPT=$PIECE(MAGDATA,U,17)
+9 ; No CPT code found
IF 'MAGCPT
QUIT
+10 ;
+11 ; Get treating facilities
+12 DO FACLIST^MAGJLST1(.MAGOUT,RADFN)
+13 ; No treating facilities found
IF MAGOUT(0)'>0
QUIT
+14 ;
+15 SET SSEP="`"
+16 SET PLACEID=DUZ(2)
+17 ;
+18 ; TAGS
+19 SET J=0
+20 SET J=J+1
SET MSGTAGS(J)="patientDfn`"_RADFN
+21 IF $LENGTH($TEXT(GETICN^MPIF001))
Begin DoDot:1
+22 SET ICN=$$GETICN^MPIF001(RADFN)
+23 if ICN>1
SET J=J+1
SET MSGTAGS(J)="patientIcn`"_ICN
+24 QUIT
End DoDot:1
+25 ;
+26 SET MAGI=0
+27 FOR
SET MAGI=$ORDER(MAGOUT(MAGI))
if 'MAGI
QUIT
Begin DoDot:1
+28 SET J=J+1
SET MSGTAGS(J)="treatingStation"_MAGI_"`"_$PIECE(MAGOUT(MAGI),"^")
+29 QUIT
End DoDot:1
+30 ;
+31 SET J=J+1
SET MSGTAGS(J)="CPT`"_MAGCPT
+32 ; precache flag
SET J=J+1
SET MSGTAGS(J)="remoteprior`1"
+33 ;
+34 SET TYPE="PRECACHE"
+35 SET SUBTYPE="REMOTEPRIOR"
+36 SET STATUS="New"
+37 SET PRIORITY=0
+38 ;
+39 ;IA # 2171
SET PLACEID=$$STA^XUAF4(PLACEID)
+40 ;
+41 ; CREATED BY
SET CRTUSR=DUZ
+42 ;
+43 SET CRTAPP="PRECACHE"
+44 ;
+45 DO CRTITEM^MAGVIM01(.MAGOUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
+46 QUIT
+47 ;
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,"^","~")
