source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGSIXG1.m@ 1604

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

revised back to 6/30/08 version

File size: 6.8 KB
Line 
1MAGSIXG1 ;WOIFO/EdM/GEK/SEB - RPCs for Document Imaging ; 04/29/2002 16:15
2 ;;3.0;IMAGING;**8,48**;Jan 11, 2005
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 ;
20 ; OUT ;--- Output array
21 ; CLS ;--- Class
22 ; TYPE ;-- Type (of what?)
23 ; SPEC ;-- Specialty or SubSpecialty
24 ; EVENT ;- Event or Procedure or Action
25PGI(OUT,DFN,PKG,CLS,TYPE,EVENT,SPEC,FROM,UNTIL,ORIGIN) ;RPC [MAG4 PAT GET IMAGES]
26 ; Get Images for Patient.
27 ; New call in Patch 3.0.8 uses Image Filter to get list of images
28 ;
29 N C,DAT1,DAT2,E,IMAGE,N,OK,P,RDT,RESULT,S,T,V,CT,PKG1,CLS1,TYPE1,EVENT1,SPEC1,FLTX,FLTY,CAPDUZ,CAPDT,MAGVR,FNL
30 S FROM=$G(FROM),UNTIL=$G(UNTIL)
31 D REVDT(FROM,UNTIL,.DAT1,.DAT2)
32 S RESULT="OUT" K OUT,^TMP($T(+0),$J)
33 S PKG=$G(PKG),CLS=$G(CLS),EVENT=$G(EVENT),SPEC=$G(SPEC),TYPE=$G(TYPE),ORIGIN=$G(ORIGIN)
34 I PKG'="" D PKG^MAGSIXGT Q:$D(OUT(0))
35 I CLS'="" D CLS^MAGSIXGT Q:$D(OUT(0))
36 I EVENT'="" D EVENT^MAGSIXGT Q:$D(OUT(0))
37 I SPEC'="" D SPEC^MAGSIXGT Q:$D(OUT(0))
38 I TYPE'="" D TYPE^MAGSIXGT Q:$D(OUT(0))
39 I ORIGIN'="" D ORIGIN^MAGSIXGT Q:$D(OUT(0))
40 I +DFN'=DFN S @RESULT@(0)="0^Invalid Patient Number: """_DFN_"""." Q
41 I '$D(^DPT(DFN,0))#2 S @RESULT@(0)="0^No Such Patient: """_DFN_"""." Q
42 S N=0
43 D NETPLCS^MAGGTU6
44 ;S RDT="" F S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:RDT="" D
45 ;3.0.8/gek, Quit searching all images, just do the date range.
46 S RDT=DAT1 F S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:(RDT="")!(RDT>DAT2) D
47 . N COUNT,PRX,X0,X2,X40,I1,X01
48 . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX="" D
49 . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX,IMAGE)) Q:IMAGE="" D
50 . . . S X0=$G(^MAG(2005,IMAGE,0))
51 . . . Q:$P(X0,"^",10) ; child of Group
52 . . . S X2=$G(^MAG(2005,IMAGE,2)),X40=$G(^MAG(2005,IMAGE,40)),I1=$O(^MAG(2005,IMAGE,1,0))
53 . . . S P=$P(X40,U),C=$P(X40,"^",2),T=$P(X40,"^",3),E=$P(X40,"^",4),S=$P(X40,"^",5)
54 . . . S V=$S($P(X40,"^",6)="":"V",1:$P(X40,"^",6)) ; P48T1 show VA for Null
55 . . . D CHK^DIE(2005,45,"E",V,.MAGVR) S V=MAGVR(0) ; P48T1 show External Value
56 . . . I PKG'="",P'="",'$D(OK(5,P)) Q
57 . . . I ORIGIN'="",V'="",'$D(OK(6,V)) Q
58 . . . I CLS'="",C'="",'$D(OK(1,C)) Q
59 . . . I EVENT'="",E,'$D(OK(2,E)) Q
60 . . . ;3.0.8 Stop list entries with no Event, if Event is in Search Specs
61 . . . I EVENT'="",E="" Q
62 . . . I SPEC'="",S,'$D(OK(3,S)) Q
63 . . . ;3.0.8 Stop list entries with no Spec, if Spec is in Search Specs
64 . . . I SPEC'="",S="" Q
65 . . . I TYPE'="",T,'$D(OK(4,T)) Q
66 . . . ; Get Count of Images in Group, use 4th piece of ,1,0) multiple
67 . . . S COUNT=$S($P($G(^MAG(2005,IMAGE,1,0)),"^",4):$P($G(^MAG(2005,IMAGE,1,0)),"^",4),1:1)
68 . . . S FLTX=""
69 . . . ; PUT in Site Code as 2nd piece.
70 . . . S X01=$S(I1:$G(^MAG(2005,+$G(^MAG(2005,IMAGE,1,I1,0)),0)),1:X0)
71 . . . S FNL=$S(+$P(X01,"^",3):$P(X01,"^",3),1:+$P(X01,"^",5))
72 . . . S FLTX=$P($G(MAGJOB("NETPLC",FNL)),"^",2)
73 . . . S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",5),"5Z"),"@",1)
74 . . . S FLTX=FLTX_"^"_$P(X0,"^",8)_"^"_COUNT_"^"_$P(X2,"^",4)
75 . . . S FLTX=FLTX_"^"_P
76 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.82,+C,0)),"^",1)
77 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.83,+T,0)),"^",1)
78 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.84,+S,0)),"^",1)
79 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.85,+E,0)),"^",1)
80 . . . S FLTX=FLTX_"^"_V
81 . . . S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",1),"5Z"),"@",1)
82 . . . ; P8T36 gek. Fix Error caused if $P(X2,"^",2) "ImageSavedBy" is null
83 . . . S FLTX=FLTX_"^"_$$GET1^DIQ(200,+$P(X2,"^",2)_",",.01)
84 . . . N MAGFILE,MAGXX
85 . . . S MAGXX=IMAGE D INFO^MAGGTII
86 . . . S FLTX=FLTX_"^"_$P(MAGFILE,"^",1)
87 . . . S N=N+1,@RESULT@(N+1)=N_"^"_FLTX_"|"_MAGFILE
88 . . . Q:N<101 Q:RESULT["^"
89 . . . ; Image count is getting big, switch from array to Global return type
90 . . . S ^TMP($T(+0),$J)=""
91 . . . M ^TMP($T(+0),$J)=OUT
92 . . . K OUT
93 . . . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
94 . . . S RESULT=$NA(^TMP($T(+0),$J))
95 . . . S OUT=$NA(^TMP($T(+0),$J)) ;GEK 10/01/02
96 . . . Q
97 . . Q
98 . Q
99 S FLTY=$$FLTDESC(X)
100 I 'N S @RESULT@(0)="0^No images for filter: "_FLTY Q
101 S @RESULT@(0)="1^"_FLTY
102 S @RESULT@(1)="Item~S2^Site^Proc DT~S1^Procedure^# Img~S2^Short Desc^Pkg^Class^Type^Specialty^Event^Origin^Cap Dt~S1~W0^Cap by~~W0^Image ID~S2~W0"
103 Q
104FLTDESC(X) ;
105 N FLT
106 S FLT=""
107 ; Package
108 S FLT=FLT_$S(PKG="":"",1:"Pkg: "_PKG_" - ")
109 ; Class
110 S FLT=FLT_$S(CLS="":"",CLS="ADMIN,ADMIN/CLIN,CLIN/ADMIN":"Class: ADMIN - ",CLS="CLIN,CLIN/ADMIN,ADMIN/CLIN":"Class: CLIN - ",1:"Class: "_CLS_" - ")
111 ; Type
112 F CT=1:1:$L(TYPE,",") D
113 . S TYPE1=$P(TYPE,",",CT) I TYPE1'="" S TYPE1=$P($G(^MAG(2005.83,TYPE1,0)),"^")
114 . S $P(TYPE,",",CT)=$E(TYPE1)_$$LOW^XLFSTR($E(TYPE1,2,999))
115 S FLT=FLT_$S(TYPE="":"",1:"Type: "_TYPE_" - ")
116 ; Specialty/SubSpecialty
117 F CT=1:1:$L(SPEC,",") D
118 . S SPEC1=$P(SPEC,",",CT) I SPEC1'="" S SPEC1=$P($G(^MAG(2005.84,SPEC1,0)),"^")
119 . S $P(SPEC,",",CT)=$E(SPEC1)_$$LOW^XLFSTR($E(SPEC1,2,999))
120 S FLT=FLT_$S(SPEC="":"",1:"Spec.: "_SPEC_" - ")
121 ; Procedure/Event
122 F CT=1:1:$L(EVENT,",") D
123 . S EVENT1=$P(EVENT,",",CT) I EVENT1'="" S EVENT1=$P($G(^MAG(2005.85,EVENT1,0)),"^")
124 . S $P(EVENT,",",CT)=$E(EVENT1)_$$LOW^XLFSTR($E(EVENT1,2,999))
125 S FLT=FLT_$S(EVENT="":"",1:"Event: "_EVENT_" - ")
126 ; Orgin
127 S FLT=FLT_$S(ORIGIN="":"",1:"Origin: "_ORIGIN_" - ")
128 ; Date Range - From
129 S FROM=$S($G(FROM)="":"",1:" from "_FROM)
130 ; Date Range - Until
131 S UNTIL=$S($G(UNTIL)="":"",1:" to "_UNTIL)
132 S FLT=FLT_$G(FROM)_$G(UNTIL)
133 ; If No Filter. Then get All.
134 I FLT="" S FLT="All Images"
135 Q FLT
136REVDT(FROM,UNTIL,DAT1,DAT2) ; Calculate the Reverse Dates and switch for $O
137 ; for $O( through a data cross reference that is reversed, i.e. X=9999999.9999-DT
138 ; FROM = Date in External or Internal
139 ; UNTIL = Date in External or Internal
140 ; DAT1 = Reverse the two dates, FROM and UNTIL, equal to the earliest
141 ; DAT2 = Reverse the two dates, FROM and UNTIL, equal to the latest
142 ;
143 S DAT1=$$E2I^MAGSIXGT($G(FROM))
144 S DAT2=$$E2I^MAGSIXGT($G(UNTIL))
145 I 'DAT2 S DAT2=9999999.9999
146 S DAT1=9999999.9999-DAT1
147 S DAT2=9999999.9999-DAT2
148 I DAT1]DAT2 S X=DAT1,DAT1=DAT2,DAT2=X
149 S DAT1=DAT1\1,$P(DAT2,".",2)="9999"
150 Q
Note: See TracBrowser for help on using the repository browser.