- 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 Feb 18, 2025@23:34 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,"^","~")