MAGJLS3A ;WIRMFO/JHC VRAD Exam lists ; 29 Apr 2005 10:00 AM
;;3.0;IMAGING;**18**;Mar 07, 2006
;; +---------------------------------------------------------------+
;; | 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
; EPs:
; BLDSTAT--Subrtn for exams list compile
; HISTBLD -- HISTORY List exams
;
BLDSTAT ; build list of Exam Status codes: STAT(CATEGORY,IMAG_TYP,STAT)=STATNM
; called from magjls3
N X,CAT,TYP,STNM K STAT S CAT="",STAT=0
F S CAT=$O(^RA(72,"AVC",CAT)) Q:CAT="" D
. S X=$S(CAT="E":3,1:2),X=$P($G(^MAG(2006.69,1,0)),U,X)
. S:'X X=$S(CAT="E":30,1:6) S X=$H-X+1,X=$$HTFM^XLFDT(X),X=9999999.9999-X
. S STAT(CAT)=X
. F S STAT=$O(^RA(72,"AVC",CAT,STAT)) Q:'STAT D
.. S TYP=$P($G(^RA(72,STAT,0)),U,7),STNM=$P(^(0),U) S:TYP="" TYP="~"
.. S STAT(CAT,TYP)=$P($G(^RA(79.2,TYP,0)),U,3),STAT(CAT,TYP,STAT)=STNM
Q
;
HISTBLD ;Compile HISTORY List
; Adds records to History List file; initiated by RPC call MAGJ HISTORYLIST/txid=1
; called from magjls3
N CNT,INDX,RAST,STATCHK,RECLIST,EXID,PIPE3
S X=$G(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0)),INDX=+$P(X,U,2) ; High_IEN ^ Last_Proc_IEN
F S INDX=$O(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",INDX)) Q:'INDX S X=^(INDX) D
. S EXID=$P(X,"|",2),PIPE3=$P(X,"|",3)
. S RADFN=$P(EXID,U),RADTI=$P(EXID,U,2),RACNI=$P(EXID,U,3),(RAST,STATCHK)=""
. D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
. I MAGRET D SVMAG2A^MAGJLS3(PIPE3)
. S $P(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0),U,2)=INDX
Q
;
END Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJLS3A 2399 printed Nov 22, 2024@17:16:54 Page 2
MAGJLS3A ;WIRMFO/JHC VRAD Exam lists ; 29 Apr 2005 10:00 AM
+1 ;;3.0;IMAGING;**18**;Mar 07, 2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 QUIT
+18 ; EPs:
+19 ; BLDSTAT--Subrtn for exams list compile
+20 ; HISTBLD -- HISTORY List exams
+21 ;
BLDSTAT ; build list of Exam Status codes: STAT(CATEGORY,IMAG_TYP,STAT)=STATNM
+1 ; called from magjls3
+2 NEW X,CAT,TYP,STNM
KILL STAT
SET CAT=""
SET STAT=0
+3 FOR
SET CAT=$ORDER(^RA(72,"AVC",CAT))
if CAT=""
QUIT
Begin DoDot:1
+4 SET X=$SELECT(CAT="E":3,1:2)
SET X=$PIECE($GET(^MAG(2006.69,1,0)),U,X)
+5 if 'X
SET X=$SELECT(CAT="E":30,1:6)
SET X=$HOROLOG-X+1
SET X=$$HTFM^XLFDT(X)
SET X=9999999.9999-X
+6 SET STAT(CAT)=X
+7 FOR
SET STAT=$ORDER(^RA(72,"AVC",CAT,STAT))
if 'STAT
QUIT
Begin DoDot:2
+8 SET TYP=$PIECE($GET(^RA(72,STAT,0)),U,7)
SET STNM=$PIECE(^(0),U)
if TYP=""
SET TYP="~"
+9 SET STAT(CAT,TYP)=$PIECE($GET(^RA(79.2,TYP,0)),U,3)
SET STAT(CAT,TYP,STAT)=STNM
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
HISTBLD ;Compile HISTORY List
+1 ; Adds records to History List file; initiated by RPC call MAGJ HISTORYLIST/txid=1
+2 ; called from magjls3
+3 NEW CNT,INDX,RAST,STATCHK,RECLIST,EXID,PIPE3
+4 ; High_IEN ^ Last_Proc_IEN
SET X=$GET(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0))
SET INDX=+$PIECE(X,U,2)
+5 FOR
SET INDX=$ORDER(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",INDX))
if 'INDX
QUIT
SET X=^(INDX)
Begin DoDot:1
+6 SET EXID=$PIECE(X,"|",2)
SET PIPE3=$PIECE(X,"|",3)
+7 SET RADFN=$PIECE(EXID,U)
SET RADTI=$PIECE(EXID,U,2)
SET RACNI=$PIECE(EXID,U,3)
SET (RAST,STATCHK)=""
+8 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
+9 IF MAGRET
DO SVMAG2A^MAGJLS3(PIPE3)
+10 SET $PIECE(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0),U,2)=INDX
End DoDot:1
+11 QUIT
+12 ;
END ;
QUIT
