MAGDCRP ;WIRMFO/JHC CR-PARAMETERS RPC ; 27 July 2006 10:05 AM
;;3.0;IMAGING;**65**;Jul 27, 2006;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. |
;; +---------------------------------------------------------------+
;;
Q
ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
RPCIN(MAGGRY,PARAMS) ; RPC: MAGD CR PARAMS
;PARAMS: SLOC--Location code of interest
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGDCRP"
N DIQUIET,GLOC,LOCIEN,MAGLST,MANIEN,MANUF,MODEL,MODIEN,REC,REPLY,SLOC,VERSION,VERIEN
S SLOC=$P(PARAMS,U)
S MAGLST="MAGDRPC" K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
N CT S CT=0
S DIQUIET=1 D DT^DICRW
I 'SLOC S REPLY="Invalid parameter passed to MAGD CR PARAMS call ("_SLOC_")." G RPCINZ
S LOCIEN=$O(^MAG(2006.623,"B",SLOC,""))
I 'LOCIEN S REPLY="No Location data defined in CR Parameter file ("_SLOC_")." G RPCINZ
S GLOC=$NA(^MAG(2006.623,LOCIEN)),MANIEN=0
F S MANIEN=$O(@GLOC@(1,MANIEN)) Q:'MANIEN S MANUF=^(MANIEN,0),MODIEN=0 D
. F S MODIEN=$O(@GLOC@(1,MANIEN,1,MODIEN)) Q:'MODIEN S MODEL=^(MODIEN,0),VERSION=0 D
. . F S VERSION=$O(@GLOC@(1,MANIEN,1,MODIEN,1,"B",VERSION)) Q:VERSION="" S VERIEN=$O(^(VERSION,"")) D
. . . S X=$G(@GLOC@(1,MANIEN,1,MODIEN,1,VERIEN,0)) Q:X=""
. . . S REC=SLOC_"|"_MANUF_"|"_MODEL_"|"_VERSION_"|"_+$P(X,U,2)
. . . S CT=CT+1,@MAGGRY@(CT)=REC
S REPLY=CT_" records returned"
;
RPCINZ S @MAGGRY@(0)=CT_U_REPLY
Q
;
EECR ;
W @IOF,!!?10,"** Enter/Edit MAG CR PARAMETER data **",!!
N MAGIEN
K DIC S (DIC,DLAYGO)=2006.623,DIC(0)="ALMEQN"
D ^DIC I Y=-1 K DIC,DIE,DR,DLAYGO Q
S DIE=2006.623,DA=+Y
S DR=".01;1;",DR(2,2006.6231)=".01;1;",DR(3,2006.62311)=".01;1;",DR(4,2006.623111)=".01;1;"
S MAGIEN=DA
D ^DIE I '$D(DA) G EECR
G EECR
Q
;
INCR ;
W @IOF,!!?10,"** Inquire MAG CR PARAMETER data **",!!
N MAGIEN,BY,FR,TO
S DIC=2006.623,DIC(0)="AMEQ"
D ^DIC I Y=-1 K DIC Q
S DA=+Y,(FR,TO)=$P(Y,U,2),MAGIEN=DA,L=0
S BY="#.01",FLDS="[MAGD CR PARAM LIST]",DIS(0)="I D0=MAGIEN"
D EN1^DIP
R !,"Enter RETURN to continue: ",X:DTIME W !
G INCR
Q
;
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDCRP 3069 printed Apr 09, 2024@21:05:51 Page 2
MAGDCRP ;WIRMFO/JHC CR-PARAMETERS RPC ; 27 July 2006 10:05 AM
+1 ;;3.0;IMAGING;**65**;Jul 27, 2006;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 ;; | |
+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
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^4~"_ERR
+1 DO @^%ZOSF("ERRTN")
+2 if $QUIT
QUIT 1
QUIT
+3 ;
RPCIN(MAGGRY,PARAMS) ; RPC: MAGD CR PARAMS
+1 ;PARAMS: SLOC--Location code of interest
+2 ;
+3 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGDCRP"
+4 NEW DIQUIET,GLOC,LOCIEN,MAGLST,MANIEN,MANUF,MODEL,MODIEN,REC,REPLY,SLOC,VERSION,VERIEN
+5 SET SLOC=$PIECE(PARAMS,U)
+6 SET MAGLST="MAGDRPC"
KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+7 NEW CT
SET CT=0
+8 SET DIQUIET=1
DO DT^DICRW
+9 IF 'SLOC
SET REPLY="Invalid parameter passed to MAGD CR PARAMS call ("_SLOC_")."
GOTO RPCINZ
+10 SET LOCIEN=$ORDER(^MAG(2006.623,"B",SLOC,""))
+11 IF 'LOCIEN
SET REPLY="No Location data defined in CR Parameter file ("_SLOC_")."
GOTO RPCINZ
+12 SET GLOC=$NAME(^MAG(2006.623,LOCIEN))
SET MANIEN=0
+13 FOR
SET MANIEN=$ORDER(@GLOC@(1,MANIEN))
if 'MANIEN
QUIT
SET MANUF=^(MANIEN,0)
SET MODIEN=0
Begin DoDot:1
+14 FOR
SET MODIEN=$ORDER(@GLOC@(1,MANIEN,1,MODIEN))
if 'MODIEN
QUIT
SET MODEL=^(MODIEN,0)
SET VERSION=0
Begin DoDot:2
+15 FOR
SET VERSION=$ORDER(@GLOC@(1,MANIEN,1,MODIEN,1,"B",VERSION))
if VERSION=""
QUIT
SET VERIEN=$ORDER(^(VERSION,""))
Begin DoDot:3
+16 SET X=$GET(@GLOC@(1,MANIEN,1,MODIEN,1,VERIEN,0))
if X=""
QUIT
+17 SET REC=SLOC_"|"_MANUF_"|"_MODEL_"|"_VERSION_"|"_+$PIECE(X,U,2)
+18 SET CT=CT+1
SET @MAGGRY@(CT)=REC
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET REPLY=CT_" records returned"
+20 ;
RPCINZ SET @MAGGRY@(0)=CT_U_REPLY
+1 QUIT
+2 ;
EECR ;
+1 WRITE @IOF,!!?10,"** Enter/Edit MAG CR PARAMETER data **",!!
+2 NEW MAGIEN
+3 KILL DIC
SET (DIC,DLAYGO)=2006.623
SET DIC(0)="ALMEQN"
+4 DO ^DIC
IF Y=-1
KILL DIC,DIE,DR,DLAYGO
QUIT
+5 SET DIE=2006.623
SET DA=+Y
+6 SET DR=".01;1;"
SET DR(2,2006.6231)=".01;1;"
SET DR(3,2006.62311)=".01;1;"
SET DR(4,2006.623111)=".01;1;"
+7 SET MAGIEN=DA
+8 DO ^DIE
IF '$DATA(DA)
GOTO EECR
+9 GOTO EECR
+10 QUIT
+11 ;
INCR ;
+1 WRITE @IOF,!!?10,"** Inquire MAG CR PARAMETER data **",!!
+2 NEW MAGIEN,BY,FR,TO
+3 SET DIC=2006.623
SET DIC(0)="AMEQ"
+4 DO ^DIC
IF Y=-1
KILL DIC
QUIT
+5 SET DA=+Y
SET (FR,TO)=$PIECE(Y,U,2)
SET MAGIEN=DA
SET L=0
+6 SET BY="#.01"
SET FLDS="[MAGD CR PARAM LIST]"
SET DIS(0)="I D0=MAGIEN"
+7 DO EN1^DIP
+8 READ !,"Enter RETURN to continue: ",X:DTIME
WRITE !
+9 GOTO INCR
+10 QUIT
+11 ;
+12 ;
END ;
