Changeset 636 for FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGSIXG1.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• IMAGING-MAG-ZMAG/MAGSIXG1.m (modified) (4 diffs)

FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGSIXG1.m

@@ -1 +1 @@
 MAGSIXG1 ;WOIFO/EdM/GEK/SEB - RPCs for Document Imaging ; 04/29/2002  16:15
- ;;3.0;IMAGING;**8,48,59**;Nov 27, 2007;Build 20
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+ ;;3.0;IMAGING;**8,48**;Jan 11, 2005
  ;; +---------------------------------------------------------------+
  ;; | Property of the US Government.                                |
@@ -19 +18 @@
  Q
  ;
- ; OUT  =  Output array.  
- ;   OUT(0)        ->  1|0 ^ message
- ;   OUT(1)        ->  Field Headers 
- ;       '^' delimited list of column headers used in cMagListView
- ;   OUT(2..n) ->  each line is information on 1 image.
- ;       piece '|' 1 is '^' delimited data to be displayed in columns.
- ;       piece '|' 2  is data that is used internally by App.
- ;       
- ; PKG   - Package fld 40
- ; CLS   - Class   fld 41
- ; TYPE  - Type    fld 42
- ; EVENT - Proc/Event         fld 43
- ; SPEC  - Spec/SubSpecialty  fld 44
- ; FROM  - Date to search from
- ; UNTIL - Date to search to
- ; ORIGIN - Origin fld 45
- ; DATA  -  Future
- ; FLGS  -  Future  
- ; 
-PGI(OUT,DFN,PKG,CLS,TYPE,EVENT,SPEC,FROM,UNTIL,ORIGIN,DATA,FLGS) ;RPC [MAG4 PAT GET IMAGES]
+ ; OUT ;--- Output array
+ ; CLS ;--- Class
+ ; TYPE ;-- Type (of what?)
+ ; SPEC ;-- Specialty or SubSpecialty
+ ; EVENT ;- Event or Procedure or Action
+PGI(OUT,DFN,PKG,CLS,TYPE,EVENT,SPEC,FROM,UNTIL,ORIGIN) ;RPC [MAG4 PAT GET IMAGES]
  ; Get Images for Patient.  
  ; New call in Patch 3.0.8 uses Image Filter to get list of images
+ ; 
  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
  S FROM=$G(FROM),UNTIL=$G(UNTIL)
@@ -56 +42 @@
  S N=0
  D NETPLCS^MAGGTU6
+ ;S RDT="" F  S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:RDT=""  D
  ;3.0.8/gek, Quit searching all images, just do the date range.
  S RDT=DAT1 F  S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:(RDT="")!(RDT>DAT2)  D
- . K ^TMP($J,"MAGSIX")
  . N COUNT,PRX,X0,X2,X40,I1,X01
- . S PRX="" F  S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX=""  M ^TMP($J,"MAGSIX")=^MAG(2005,"APDTPX",DFN,RDT,PRX)
- . S IMAGE="" F  S IMAGE=$O(^TMP($J,"MAGSIX",IMAGE),-1) Q:IMAGE=""  D
- . . S X0=$G(^MAG(2005,IMAGE,0))
- . . Q:$P(X0,"^",10)  ; child of Group
- . . S X2=$G(^MAG(2005,IMAGE,2)),X40=$G(^MAG(2005,IMAGE,40)),I1=$O(^MAG(2005,IMAGE,1,0))
- . . S P=$P(X40,U),C=$P(X40,"^",2),T=$P(X40,"^",3),E=$P(X40,"^",4),S=$P(X40,"^",5)
- . . ;Patch 59.  Treat Class as a computed Field.  Arrange with Mike to change DB.
- . . S C=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^(0),"^",2))
- . . S V=$S($P(X40,"^",6)="":"V",1:$P(X40,"^",6)) ; P48T1 show VA for Null
- . . D CHK^DIE(2005,45,"E",V,.MAGVR) I MAGVR'="^" S V=MAGVR(0) ; P48T1 show External Value
- . . I PKG'="",P'="",'$D(OK(5,P)) Q
- . . I ORIGIN'="",V'="",'$D(OK(6,V)) Q
- . . I CLS'="",C'="",'$D(OK(1,C)) Q
- . . I EVENT'="",E,'$D(OK(2,E)) Q
- . . ;3.0.8 Stop list entries with no Event, if Event is in Search Specs
- . . I EVENT'="",E="" Q
- . . I SPEC'="",S,'$D(OK(3,S)) Q
- . . ;3.0.8 Stop list entries with no Spec, if Spec is in Search Specs
- . . I SPEC'="",S="" Q
- . . I TYPE'="",T,'$D(OK(4,T)) Q
- . . ; Get Count of Images in Group, use 4th piece of ,1,0) multiple
- . . S COUNT=$S($P($G(^MAG(2005,IMAGE,1,0)),"^",4):$P($G(^MAG(2005,IMAGE,1,0)),"^",4),1:1)
- . . S FLTX=""
- . . ; PUT in Site Code as 2nd piece.
- . . S X01=$S(I1:$G(^MAG(2005,+$G(^MAG(2005,IMAGE,1,I1,0)),0)),1:X0)
- . . S FNL=$S(+$P(X01,"^",3):$P(X01,"^",3),1:+$P(X01,"^",5))
- . . S FLTX=$P($G(MAGJOB("NETPLC",FNL)),"^",2)
- . . I FLTX="" S FLTX=$G(MAGJOB("PLCODE"))
- . . S FLTX=FLTX_"^"_$$RPTITLE($P(X2,"^",6),$P(X2,"^",7))
- . . S X=$$FMTE^XLFDT($P(X2,"^",5),"5Z")
- . . S X=$P(X,"@",1)_" "_$S($L($P(X,"@",2)):$P(X,"@",2),1:"00:01")
- . . S FLTX=FLTX_"^"_X
- . . S FLTX=FLTX_"^"_$P(X0,"^",8)_"^"_COUNT_"^"_$P(X2,"^",4)
- . . S FLTX=FLTX_"^"_P
- . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.82,+C,0)),"^",1)
- . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.83,+T,0)),"^",1)
- . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.84,+S,0)),"^",1)
- . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.85,+E,0)),"^",1)
- . . S FLTX=FLTX_"^"_V
- . . ;S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",1),"5Z"),"@",1)
- . . S X=$$FMTE^XLFDT($P(X2,"^",1),"5Z")
- . . S X=$P(X,"@",1)_" "_$S($L($P(X,"@",2)):$P(X,"@",2),1:"00:01")
- . . S FLTX=FLTX_"^"_X
- . . ;;;;;;;;;
- . . ; P8T36 gek. Fix Error caused if $P(X2,"^",2) "ImageSavedBy" is null
- . . S FLTX=FLTX_"^"_$$GET1^DIQ(200,+$P(X2,"^",2)_",",.01)
- . . N MAGFILE,MAGXX
- . . S MAGXX=IMAGE D INFO^MAGGTII
- . . S FLTX=FLTX_"^"_$P(MAGFILE,"^",1)
- . . S N=N+1,@RESULT@(N+1)=N_"^"_FLTX_"|"_MAGFILE
- . . Q:N<76  Q:RESULT["^"
- . . ; Image count is getting big, switch from array to Global return type
- . . S ^TMP($T(+0),$J)=""
- . . M ^TMP($T(+0),$J)=OUT
- . . K OUT
- . . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
- . . S RESULT=$NA(^TMP($T(+0),$J))
- . . S OUT=$NA(^TMP($T(+0),$J)) ;GEK 10/01/02
+ . S PRX="" F  S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX=""  D
+ . . S IMAGE="" F  S IMAGE=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX,IMAGE)) Q:IMAGE=""  D
+ . . . S X0=$G(^MAG(2005,IMAGE,0))
+ . . . Q:$P(X0,"^",10)  ; child of Group
+ . . . S X2=$G(^MAG(2005,IMAGE,2)),X40=$G(^MAG(2005,IMAGE,40)),I1=$O(^MAG(2005,IMAGE,1,0))
+ . . . S P=$P(X40,U),C=$P(X40,"^",2),T=$P(X40,"^",3),E=$P(X40,"^",4),S=$P(X40,"^",5)
+ . . . S V=$S($P(X40,"^",6)="":"V",1:$P(X40,"^",6)) ; P48T1 show VA for Null
+ . . . D CHK^DIE(2005,45,"E",V,.MAGVR) S V=MAGVR(0) ; P48T1 show External Value
+ . . . I PKG'="",P'="",'$D(OK(5,P)) Q
+ . . . I ORIGIN'="",V'="",'$D(OK(6,V)) Q
+ . . . I CLS'="",C'="",'$D(OK(1,C)) Q
+ . . . I EVENT'="",E,'$D(OK(2,E)) Q
+ . . . ;3.0.8 Stop list entries with no Event, if Event is in Search Specs
+ . . . I EVENT'="",E="" Q
+ . . . I SPEC'="",S,'$D(OK(3,S)) Q
+ . . . ;3.0.8 Stop list entries with no Spec, if Spec is in Search Specs
+ . . . I SPEC'="",S="" Q
+ . . . I TYPE'="",T,'$D(OK(4,T)) Q
+ . . . ; Get Count of Images in Group, use 4th piece of ,1,0) multiple
+ . . . S COUNT=$S($P($G(^MAG(2005,IMAGE,1,0)),"^",4):$P($G(^MAG(2005,IMAGE,1,0)),"^",4),1:1)
+ . . . S FLTX=""
+ . . . ; PUT in Site Code as 2nd piece.
+ . . . S X01=$S(I1:$G(^MAG(2005,+$G(^MAG(2005,IMAGE,1,I1,0)),0)),1:X0)
+ . . . S FNL=$S(+$P(X01,"^",3):$P(X01,"^",3),1:+$P(X01,"^",5))
+ . . . S FLTX=$P($G(MAGJOB("NETPLC",FNL)),"^",2)
+ . . . S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",5),"5Z"),"@",1)
+ . . . S FLTX=FLTX_"^"_$P(X0,"^",8)_"^"_COUNT_"^"_$P(X2,"^",4)
+ . . . S FLTX=FLTX_"^"_P
+ . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.82,+C,0)),"^",1)
+ . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.83,+T,0)),"^",1)
+ . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.84,+S,0)),"^",1)
+ . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.85,+E,0)),"^",1)
+ . . . S FLTX=FLTX_"^"_V
+ . . . S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",1),"5Z"),"@",1)
+ . . . ; P8T36 gek. Fix Error caused if $P(X2,"^",2) "ImageSavedBy" is null
+ . . . S FLTX=FLTX_"^"_$$GET1^DIQ(200,+$P(X2,"^",2)_",",.01)
+ . . . N MAGFILE,MAGXX
+ . . . S MAGXX=IMAGE D INFO^MAGGTII
+ . . . S FLTX=FLTX_"^"_$P(MAGFILE,"^",1)
+ . . . S N=N+1,@RESULT@(N+1)=N_"^"_FLTX_"|"_MAGFILE
+ . . . Q:N<101  Q:RESULT["^"
+ . . . ; Image count is getting big, switch from array to Global return type
+ . . . S ^TMP($T(+0),$J)=""
+ . . . M ^TMP($T(+0),$J)=OUT
+ . . . K OUT
+ . . . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+ . . . S RESULT=$NA(^TMP($T(+0),$J))
+ . . . S OUT=$NA(^TMP($T(+0),$J)) ;GEK 10/01/02
+ . . . Q
  . . Q
- . ;Q
  . Q
  S FLTY=$$FLTDESC(X)
  I 'N S @RESULT@(0)="0^No images for filter: "_FLTY  Q
  S @RESULT@(0)="1^"_FLTY
- 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"
- ;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"
+ 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"
  Q
-RPTITLE(FILE,IEN) ; 
- I FILE=8925,$D(^TIU(8925,IEN,0)) Q $P(^TIU(8925.1,$P(^TIU(8925,IEN,0),"^",1),0),"^",1)
- ;I FILE=8925,$D(^TIU(8925,IEN,0)) Q $$GET1^DIQ(FILE,IEN,".01:.01")
- E  Q "   "
 FLTDESC(X) ;
  N FLT
@@ -153 +124 @@
  . S $P(EVENT,",",CT)=$E(EVENT1)_$$LOW^XLFSTR($E(EVENT1,2,999))
  S FLT=FLT_$S(EVENT="":"",1:"Event: "_EVENT_" - ")
- ; Origin
+ ; Orgin
  S FLT=FLT_$S(ORIGIN="":"",1:"Origin: "_ORIGIN_" - ")
  ; Date Range - From