- 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 Mar 13, 2025@21:11:44 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
