| 1 | MAGSIXG1 ;WOIFO/EdM/GEK/SEB - RPCs for Document Imaging ; 04/29/2002 16:15
|
|---|
| 2 | ;;3.0;IMAGING;**8,48,59**;Nov 27, 2007;Build 20
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | |
|
|---|
| 12 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 13 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 14 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 15 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 16 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 17 | ;; +---------------------------------------------------------------+
|
|---|
| 18 | ;;
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | ; OUT = Output array.
|
|---|
| 22 | ; OUT(0) -> 1|0 ^ message
|
|---|
| 23 | ; OUT(1) -> Field Headers
|
|---|
| 24 | ; '^' delimited list of column headers used in cMagListView
|
|---|
| 25 | ; OUT(2..n) -> each line is information on 1 image.
|
|---|
| 26 | ; piece '|' 1 is '^' delimited data to be displayed in columns.
|
|---|
| 27 | ; piece '|' 2 is data that is used internally by App.
|
|---|
| 28 | ;
|
|---|
| 29 | ; PKG - Package fld 40
|
|---|
| 30 | ; CLS - Class fld 41
|
|---|
| 31 | ; TYPE - Type fld 42
|
|---|
| 32 | ; EVENT - Proc/Event fld 43
|
|---|
| 33 | ; SPEC - Spec/SubSpecialty fld 44
|
|---|
| 34 | ; FROM - Date to search from
|
|---|
| 35 | ; UNTIL - Date to search to
|
|---|
| 36 | ; ORIGIN - Origin fld 45
|
|---|
| 37 | ; DATA - Future
|
|---|
| 38 | ; FLGS - Future
|
|---|
| 39 | ;
|
|---|
| 40 | PGI(OUT,DFN,PKG,CLS,TYPE,EVENT,SPEC,FROM,UNTIL,ORIGIN,DATA,FLGS) ;RPC [MAG4 PAT GET IMAGES]
|
|---|
| 41 | ; Get Images for Patient.
|
|---|
| 42 | ; New call in Patch 3.0.8 uses Image Filter to get list of images
|
|---|
| 43 | 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
|
|---|
| 44 | S FROM=$G(FROM),UNTIL=$G(UNTIL)
|
|---|
| 45 | D REVDT(FROM,UNTIL,.DAT1,.DAT2)
|
|---|
| 46 | S RESULT="OUT" K OUT,^TMP($T(+0),$J)
|
|---|
| 47 | S PKG=$G(PKG),CLS=$G(CLS),EVENT=$G(EVENT),SPEC=$G(SPEC),TYPE=$G(TYPE),ORIGIN=$G(ORIGIN)
|
|---|
| 48 | I PKG'="" D PKG^MAGSIXGT Q:$D(OUT(0))
|
|---|
| 49 | I CLS'="" D CLS^MAGSIXGT Q:$D(OUT(0))
|
|---|
| 50 | I EVENT'="" D EVENT^MAGSIXGT Q:$D(OUT(0))
|
|---|
| 51 | I SPEC'="" D SPEC^MAGSIXGT Q:$D(OUT(0))
|
|---|
| 52 | I TYPE'="" D TYPE^MAGSIXGT Q:$D(OUT(0))
|
|---|
| 53 | I ORIGIN'="" D ORIGIN^MAGSIXGT Q:$D(OUT(0))
|
|---|
| 54 | I +DFN'=DFN S @RESULT@(0)="0^Invalid Patient Number: """_DFN_"""." Q
|
|---|
| 55 | I '$D(^DPT(DFN,0))#2 S @RESULT@(0)="0^No Such Patient: """_DFN_"""." Q
|
|---|
| 56 | S N=0
|
|---|
| 57 | D NETPLCS^MAGGTU6
|
|---|
| 58 | ;3.0.8/gek, Quit searching all images, just do the date range.
|
|---|
| 59 | S RDT=DAT1 F S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:(RDT="")!(RDT>DAT2) D
|
|---|
| 60 | . K ^TMP($J,"MAGSIX")
|
|---|
| 61 | . N COUNT,PRX,X0,X2,X40,I1,X01
|
|---|
| 62 | . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX="" M ^TMP($J,"MAGSIX")=^MAG(2005,"APDTPX",DFN,RDT,PRX)
|
|---|
| 63 | . S IMAGE="" F S IMAGE=$O(^TMP($J,"MAGSIX",IMAGE),-1) Q:IMAGE="" D
|
|---|
| 64 | . . S X0=$G(^MAG(2005,IMAGE,0))
|
|---|
| 65 | . . Q:$P(X0,"^",10) ; child of Group
|
|---|
| 66 | . . S X2=$G(^MAG(2005,IMAGE,2)),X40=$G(^MAG(2005,IMAGE,40)),I1=$O(^MAG(2005,IMAGE,1,0))
|
|---|
| 67 | . . S P=$P(X40,U),C=$P(X40,"^",2),T=$P(X40,"^",3),E=$P(X40,"^",4),S=$P(X40,"^",5)
|
|---|
| 68 | . . ;Patch 59. Treat Class as a computed Field. Arrange with Mike to change DB.
|
|---|
| 69 | . . S C=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^(0),"^",2))
|
|---|
| 70 | . . S V=$S($P(X40,"^",6)="":"V",1:$P(X40,"^",6)) ; P48T1 show VA for Null
|
|---|
| 71 | . . D CHK^DIE(2005,45,"E",V,.MAGVR) I MAGVR'="^" S V=MAGVR(0) ; P48T1 show External Value
|
|---|
| 72 | . . I PKG'="",P'="",'$D(OK(5,P)) Q
|
|---|
| 73 | . . I ORIGIN'="",V'="",'$D(OK(6,V)) Q
|
|---|
| 74 | . . I CLS'="",C'="",'$D(OK(1,C)) Q
|
|---|
| 75 | . . I EVENT'="",E,'$D(OK(2,E)) Q
|
|---|
| 76 | . . ;3.0.8 Stop list entries with no Event, if Event is in Search Specs
|
|---|
| 77 | . . I EVENT'="",E="" Q
|
|---|
| 78 | . . I SPEC'="",S,'$D(OK(3,S)) Q
|
|---|
| 79 | . . ;3.0.8 Stop list entries with no Spec, if Spec is in Search Specs
|
|---|
| 80 | . . I SPEC'="",S="" Q
|
|---|
| 81 | . . I TYPE'="",T,'$D(OK(4,T)) Q
|
|---|
| 82 | . . ; Get Count of Images in Group, use 4th piece of ,1,0) multiple
|
|---|
| 83 | . . S COUNT=$S($P($G(^MAG(2005,IMAGE,1,0)),"^",4):$P($G(^MAG(2005,IMAGE,1,0)),"^",4),1:1)
|
|---|
| 84 | . . S FLTX=""
|
|---|
| 85 | . . ; PUT in Site Code as 2nd piece.
|
|---|
| 86 | . . S X01=$S(I1:$G(^MAG(2005,+$G(^MAG(2005,IMAGE,1,I1,0)),0)),1:X0)
|
|---|
| 87 | . . S FNL=$S(+$P(X01,"^",3):$P(X01,"^",3),1:+$P(X01,"^",5))
|
|---|
| 88 | . . S FLTX=$P($G(MAGJOB("NETPLC",FNL)),"^",2)
|
|---|
| 89 | . . I FLTX="" S FLTX=$G(MAGJOB("PLCODE"))
|
|---|
| 90 | . . S FLTX=FLTX_"^"_$$RPTITLE($P(X2,"^",6),$P(X2,"^",7))
|
|---|
| 91 | . . S X=$$FMTE^XLFDT($P(X2,"^",5),"5Z")
|
|---|
| 92 | . . S X=$P(X,"@",1)_" "_$S($L($P(X,"@",2)):$P(X,"@",2),1:"00:01")
|
|---|
| 93 | . . S FLTX=FLTX_"^"_X
|
|---|
| 94 | . . S FLTX=FLTX_"^"_$P(X0,"^",8)_"^"_COUNT_"^"_$P(X2,"^",4)
|
|---|
| 95 | . . S FLTX=FLTX_"^"_P
|
|---|
| 96 | . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.82,+C,0)),"^",1)
|
|---|
| 97 | . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.83,+T,0)),"^",1)
|
|---|
| 98 | . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.84,+S,0)),"^",1)
|
|---|
| 99 | . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.85,+E,0)),"^",1)
|
|---|
| 100 | . . S FLTX=FLTX_"^"_V
|
|---|
| 101 | . . ;S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",1),"5Z"),"@",1)
|
|---|
| 102 | . . S X=$$FMTE^XLFDT($P(X2,"^",1),"5Z")
|
|---|
| 103 | . . S X=$P(X,"@",1)_" "_$S($L($P(X,"@",2)):$P(X,"@",2),1:"00:01")
|
|---|
| 104 | . . S FLTX=FLTX_"^"_X
|
|---|
| 105 | . . ;;;;;;;;;
|
|---|
| 106 | . . ; P8T36 gek. Fix Error caused if $P(X2,"^",2) "ImageSavedBy" is null
|
|---|
| 107 | . . S FLTX=FLTX_"^"_$$GET1^DIQ(200,+$P(X2,"^",2)_",",.01)
|
|---|
| 108 | . . N MAGFILE,MAGXX
|
|---|
| 109 | . . S MAGXX=IMAGE D INFO^MAGGTII
|
|---|
| 110 | . . S FLTX=FLTX_"^"_$P(MAGFILE,"^",1)
|
|---|
| 111 | . . S N=N+1,@RESULT@(N+1)=N_"^"_FLTX_"|"_MAGFILE
|
|---|
| 112 | . . Q:N<76 Q:RESULT["^"
|
|---|
| 113 | . . ; Image count is getting big, switch from array to Global return type
|
|---|
| 114 | . . S ^TMP($T(+0),$J)=""
|
|---|
| 115 | . . M ^TMP($T(+0),$J)=OUT
|
|---|
| 116 | . . K OUT
|
|---|
| 117 | . . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
|
|---|
| 118 | . . S RESULT=$NA(^TMP($T(+0),$J))
|
|---|
| 119 | . . S OUT=$NA(^TMP($T(+0),$J)) ;GEK 10/01/02
|
|---|
| 120 | . . Q
|
|---|
| 121 | . ;Q
|
|---|
| 122 | . Q
|
|---|
| 123 | S FLTY=$$FLTDESC(X)
|
|---|
| 124 | I 'N S @RESULT@(0)="0^No images for filter: "_FLTY Q
|
|---|
| 125 | S @RESULT@(0)="1^"_FLTY
|
|---|
| 126 | S @RESULT@(1)="Item~S2^Site^Note Title~~W0^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"
|
|---|
| 127 | ;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"
|
|---|
| 128 | Q
|
|---|
| 129 | RPTITLE(FILE,IEN) ;
|
|---|
| 130 | I FILE=8925,$D(^TIU(8925,IEN,0)) Q $P(^TIU(8925.1,$P(^TIU(8925,IEN,0),"^",1),0),"^",1)
|
|---|
| 131 | ;I FILE=8925,$D(^TIU(8925,IEN,0)) Q $$GET1^DIQ(FILE,IEN,".01:.01")
|
|---|
| 132 | E Q " "
|
|---|
| 133 | FLTDESC(X) ;
|
|---|
| 134 | N FLT
|
|---|
| 135 | S FLT=""
|
|---|
| 136 | ; Package
|
|---|
| 137 | S FLT=FLT_$S(PKG="":"",1:"Pkg: "_PKG_" - ")
|
|---|
| 138 | ; Class
|
|---|
| 139 | S FLT=FLT_$S(CLS="":"",CLS="ADMIN,ADMIN/CLIN,CLIN/ADMIN":"Class: ADMIN - ",CLS="CLIN,CLIN/ADMIN,ADMIN/CLIN":"Class: CLIN - ",1:"Class: "_CLS_" - ")
|
|---|
| 140 | ; Type
|
|---|
| 141 | F CT=1:1:$L(TYPE,",") D
|
|---|
| 142 | . S TYPE1=$P(TYPE,",",CT) I TYPE1'="" S TYPE1=$P($G(^MAG(2005.83,TYPE1,0)),"^")
|
|---|
| 143 | . S $P(TYPE,",",CT)=$E(TYPE1)_$$LOW^XLFSTR($E(TYPE1,2,999))
|
|---|
| 144 | S FLT=FLT_$S(TYPE="":"",1:"Type: "_TYPE_" - ")
|
|---|
| 145 | ; Specialty/SubSpecialty
|
|---|
| 146 | F CT=1:1:$L(SPEC,",") D
|
|---|
| 147 | . S SPEC1=$P(SPEC,",",CT) I SPEC1'="" S SPEC1=$P($G(^MAG(2005.84,SPEC1,0)),"^")
|
|---|
| 148 | . S $P(SPEC,",",CT)=$E(SPEC1)_$$LOW^XLFSTR($E(SPEC1,2,999))
|
|---|
| 149 | S FLT=FLT_$S(SPEC="":"",1:"Spec.: "_SPEC_" - ")
|
|---|
| 150 | ; Procedure/Event
|
|---|
| 151 | F CT=1:1:$L(EVENT,",") D
|
|---|
| 152 | . S EVENT1=$P(EVENT,",",CT) I EVENT1'="" S EVENT1=$P($G(^MAG(2005.85,EVENT1,0)),"^")
|
|---|
| 153 | . S $P(EVENT,",",CT)=$E(EVENT1)_$$LOW^XLFSTR($E(EVENT1,2,999))
|
|---|
| 154 | S FLT=FLT_$S(EVENT="":"",1:"Event: "_EVENT_" - ")
|
|---|
| 155 | ; Origin
|
|---|
| 156 | S FLT=FLT_$S(ORIGIN="":"",1:"Origin: "_ORIGIN_" - ")
|
|---|
| 157 | ; Date Range - From
|
|---|
| 158 | S FROM=$S($G(FROM)="":"",1:" from "_FROM)
|
|---|
| 159 | ; Date Range - Until
|
|---|
| 160 | S UNTIL=$S($G(UNTIL)="":"",1:" to "_UNTIL)
|
|---|
| 161 | S FLT=FLT_$G(FROM)_$G(UNTIL)
|
|---|
| 162 | ; If No Filter. Then get All.
|
|---|
| 163 | I FLT="" S FLT="All Images"
|
|---|
| 164 | Q FLT
|
|---|
| 165 | REVDT(FROM,UNTIL,DAT1,DAT2) ; Calculate the Reverse Dates and switch for $O
|
|---|
| 166 | ; for $O( through a data cross reference that is reversed, i.e. X=9999999.9999-DT
|
|---|
| 167 | ; FROM = Date in External or Internal
|
|---|
| 168 | ; UNTIL = Date in External or Internal
|
|---|
| 169 | ; DAT1 = Reverse the two dates, FROM and UNTIL, equal to the earliest
|
|---|
| 170 | ; DAT2 = Reverse the two dates, FROM and UNTIL, equal to the latest
|
|---|
| 171 | ;
|
|---|
| 172 | S DAT1=$$E2I^MAGSIXGT($G(FROM))
|
|---|
| 173 | S DAT2=$$E2I^MAGSIXGT($G(UNTIL))
|
|---|
| 174 | I 'DAT2 S DAT2=9999999.9999
|
|---|
| 175 | S DAT1=9999999.9999-DAT1
|
|---|
| 176 | S DAT2=9999999.9999-DAT2
|
|---|
| 177 | I DAT1]DAT2 S X=DAT1,DAT1=DAT2,DAT2=X
|
|---|
| 178 | S DAT1=DAT1\1,$P(DAT2,".",2)="9999"
|
|---|
| 179 | Q
|
|---|
