source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJLS3A.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1MAGJLS3A ;WIRMFO/JHC VRAD Exam lists ; 29 Apr 2005 10:00 AM
2 ;;3.0;IMAGING;**18**;Mar 07, 2006
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 Q
19 ; EPs:
20 ; BLDSTAT--Subrtn for exams list compile
21 ; HISTBLD -- HISTORY List exams
22 ;
23BLDSTAT ; build list of Exam Status codes: STAT(CATEGORY,IMAG_TYP,STAT)=STATNM
24 ; called from magjls3
25 N X,CAT,TYP,STNM K STAT S CAT="",STAT=0
26 F S CAT=$O(^RA(72,"AVC",CAT)) Q:CAT="" D
27 . S X=$S(CAT="E":3,1:2),X=$P($G(^MAG(2006.69,1,0)),U,X)
28 . S:'X X=$S(CAT="E":30,1:6) S X=$H-X+1,X=$$HTFM^XLFDT(X),X=9999999.9999-X
29 . S STAT(CAT)=X
30 . F S STAT=$O(^RA(72,"AVC",CAT,STAT)) Q:'STAT D
31 .. S TYP=$P($G(^RA(72,STAT,0)),U,7),STNM=$P(^(0),U) S:TYP="" TYP="~"
32 .. S STAT(CAT,TYP)=$P($G(^RA(79.2,TYP,0)),U,3),STAT(CAT,TYP,STAT)=STNM
33 Q
34 ;
35HISTBLD ;Compile HISTORY List
36 ; Adds records to History List file; initiated by RPC call MAGJ HISTORYLIST/txid=1
37 ; called from magjls3
38 N CNT,INDX,RAST,STATCHK,RECLIST,EXID,PIPE3
39 S X=$G(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0)),INDX=+$P(X,U,2) ; High_IEN ^ Last_Proc_IEN
40 F S INDX=$O(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",INDX)) Q:'INDX S X=^(INDX) D
41 . S EXID=$P(X,"|",2),PIPE3=$P(X,"|",3)
42 . S RADFN=$P(EXID,U),RADTI=$P(EXID,U,2),RACNI=$P(EXID,U,3),(RAST,STATCHK)=""
43 . D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
44 . I MAGRET D SVMAG2A^MAGJLS3(PIPE3)
45 . S $P(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0),U,2)=INDX
46 Q
47 ;
48END Q ;
Note: See TracBrowser for help on using the repository browser.