MAGJMN3 ;WIRMFO/JHC - VRad Maint functions ; 10/17/2022
;;3.0;IMAGING;**18,120,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**
Q
;
YN(MSG,DFLT) ; get Yes/No reply
N X I $G(DFLT)="" S DFLT="N"
W !
S DFLT=$E(DFLT),DFLT=$S(DFLT="N":"NO",1:"YES")
YN1 W !,MSG_" "_DFLT_"// "
R X:DTIME S:X="" X=DFLT S X=$E(X),X=$TR(X,"ynYN","YNYN")
I "YN"'[X W " ??? Enter YES or NO",! G YN1
Q X
;
EECPT ;Enter/Edit CPT MATCHING SET
W @IOF,!!?10,"** Enter/Edit ISI Rad RAD CPT MATCHING CPT CODE **",!! ; ISI
N MAGIEN
K DIC S (DIC,DLAYGO)=2006.67,DIC(0)="ALMEQN"
D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q
S DIE=2006.67,DA=+Y,DR="1;3;4;5"
S MAGIEN=DA
D ^DIE I '$D(DA) G EECPT
G EECPT
Q
INCPT ; Inquire MAG RAD CPT MATCHING
W @IOF,!!?10,"** Inquire ISI Rad CPT MATCHING CPT CODE **",!! ; ISI
N DATA,I,ZJ
INC1 W !! S DIC=2006.67,DIC(0)="AMEQ"
D ^DIC I Y=-1 K DIC Q
S DA=+Y,DATA=$P(Y,U,2)
S DATA="CPT^"_DATA_"|"
D DATADUMP^MAGJUTL4(.ZJ,DATA)
W ! S T=+$G(@ZJ@(0)) F I=1:1:T S X=$G(^(I)) W !,X
G INC1
Q
PRCPT ;Print MAG RAD CPT MATCHING LOGIC
N FLDS
W @IOF,!!?10,"** Print ISI Rad CPT MATCHING CPT CODE **",!! ; ISI
W !! S DIC=2006.67,L=0,FLDS="[MAGJ CPT MATCH PRT]"
D EN1^DIP
R !,"Enter RETURN to continue: ",X:DTIME W !
Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJMN3 2281 printed Sep 23, 2025@19:43:08 Page 2
MAGJMN3 ;WIRMFO/JHC - VRad Maint functions ; 10/17/2022
+1 ;;3.0;IMAGING;**18,120,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**
+18 QUIT
+19 ;
YN(MSG,DFLT) ; get Yes/No reply
+1 NEW X
IF $GET(DFLT)=""
SET DFLT="N"
+2 WRITE !
+3 SET DFLT=$EXTRACT(DFLT)
SET DFLT=$SELECT(DFLT="N":"NO",1:"YES")
YN1 WRITE !,MSG_" "_DFLT_"// "
+1 READ X:DTIME
if X=""
SET X=DFLT
SET X=$EXTRACT(X)
SET X=$TRANSLATE(X,"ynYN","YNYN")
+2 IF "YN"'[X
WRITE " ??? Enter YES or NO",!
GOTO YN1
+3 QUIT X
+4 ;
EECPT ;Enter/Edit CPT MATCHING SET
+1 ; ISI
WRITE @IOF,!!?10,"** Enter/Edit ISI Rad RAD CPT MATCHING CPT CODE **",!!
+2 NEW MAGIEN
+3 KILL DIC
SET (DIC,DLAYGO)=2006.67
SET DIC(0)="ALMEQN"
+4 DO ^DIC
IF Y=-1
KILL DIC,DIE,DR,DLAYGO
QUIT
+5 SET DIE=2006.67
SET DA=+Y
SET DR="1;3;4;5"
+6 SET MAGIEN=DA
+7 DO ^DIE
IF '$DATA(DA)
GOTO EECPT
+8 GOTO EECPT
+9 QUIT
INCPT ; Inquire MAG RAD CPT MATCHING
+1 ; ISI
WRITE @IOF,!!?10,"** Inquire ISI Rad CPT MATCHING CPT CODE **",!!
+2 NEW DATA,I,ZJ
INC1 WRITE !!
SET DIC=2006.67
SET DIC(0)="AMEQ"
+1 DO ^DIC
IF Y=-1
KILL DIC
QUIT
+2 SET DA=+Y
SET DATA=$PIECE(Y,U,2)
+3 SET DATA="CPT^"_DATA_"|"
+4 DO DATADUMP^MAGJUTL4(.ZJ,DATA)
+5 WRITE !
SET T=+$GET(@ZJ@(0))
FOR I=1:1:T
SET X=$GET(^(I))
WRITE !,X
+6 GOTO INC1
+7 QUIT
PRCPT ;Print MAG RAD CPT MATCHING LOGIC
+1 NEW FLDS
+2 ; ISI
WRITE @IOF,!!?10,"** Print ISI Rad CPT MATCHING CPT CODE **",!!
+3 WRITE !!
SET DIC=2006.67
SET L=0
SET FLDS="[MAGJ CPT MATCH PRT]"
+4 DO EN1^DIP
+5 READ !,"Enter RETURN to continue: ",X:DTIME
WRITE !
+6 QUIT
+7 ;
END ;
