| 1 | MAGQBUT2 ;WOIFO/SRR/RMP -IMAGE SITE PARAMETERS COMPANION [ 11/08/2001 17:18 ]
|
|---|
| 2 | ;;3.0;IMAGING;**7,8,20,81**;May 17, 2007
|
|---|
| 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 | ;; | 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 | MAGSYS(LIST) ;
|
|---|
| 19 | ; RPC[MAGQ SYSTEM]
|
|---|
| 20 | N VAIEN,NODE,MGIEN,UNAME,TDATE
|
|---|
| 21 | S MGIEN=$$FIND1^DIC(3.8,"","MX","MAG SERVER","","","ERR")
|
|---|
| 22 | S VAIEN=0
|
|---|
| 23 | F S VAIEN=$O(^XUSEC("MAG SYSTEM",VAIEN)) Q:VAIEN'?1N.N D
|
|---|
| 24 | . S UNAME=$$GET1^DIQ(200,VAIEN,.01)
|
|---|
| 25 | . Q:UNAME=""
|
|---|
| 26 | . ;CHECK FOR TERMINATION DATE
|
|---|
| 27 | . S TDATE=$$GET1^DIQ(200,VAIEN,9.2)
|
|---|
| 28 | . Q:((TDATE'="")&(TDATE<$$NOW^XLFDT))
|
|---|
| 29 | . ;the next line screens existing 'MAG SERVER' members
|
|---|
| 30 | . I MGIEN?1N.N,$$FIND1^DIC(3.81,","_MGIEN_",","QA",VAIEN,"","","ERR") Q
|
|---|
| 31 | . S LIST(VAIEN)=VAIEN_"^"_UNAME
|
|---|
| 32 | Q
|
|---|
| 33 | IMPAR(RESULT,QIEN) ; Import Array
|
|---|
| 34 | N INDX,CNT
|
|---|
| 35 | S (INDX,CNT)=0
|
|---|
| 36 | F S INDX=$O(^MAG(2006.034,QIEN,1,INDX)) Q:INDX'?1N.N D
|
|---|
| 37 | . S CNT=CNT+1
|
|---|
| 38 | . S RESULT(CNT)=$G(^MAG(2006.034,QIEN,1,INDX,0))
|
|---|
| 39 | I CNT<1 S RESULT(0)="0^Corrupted Import Array"
|
|---|
| 40 | E S RESULT(0)="1"
|
|---|
| 41 | Q
|
|---|
| 42 | CHKIMG(IEN) ;
|
|---|
| 43 | ; Given an Image IEN, return:
|
|---|
| 44 | ; 1: Case # or accession #
|
|---|
| 45 | ; 2: Parent application~IEN
|
|---|
| 46 | ; 3: Application DFN
|
|---|
| 47 | ; 4: Image DFN
|
|---|
| 48 | ; 5: Flag: true = all DFNs in images in same parent group are identical
|
|---|
| 49 | ; 6: Image object Class
|
|---|
| 50 | ;
|
|---|
| 51 | ; PF: Parent Data file number
|
|---|
| 52 | ; PT(): Parent file data dictionary
|
|---|
| 53 | ; PD0: Parent (Global root) IEN (D0)
|
|---|
| 54 | ; PD1: Lab Parent Global Root (D1)
|
|---|
| 55 | ; PD2: Parent Data File Image Pointer
|
|---|
| 56 | ; T(): Error types
|
|---|
| 57 | ; IDFN: Image file entry DFN
|
|---|
| 58 | ; PDFN: Parent file DFN
|
|---|
| 59 | ; GRG: virtual Parent File Image Multiple
|
|---|
| 60 | ; IOR: Image Object Referenced (by parent)
|
|---|
| 61 | N GF,GP,G0,GR,GRD,GRG,GR0,IDFN,IENV,P0,PD0,PD1,PD2,PF,PT,X0,X2,N0,N1,R,T,GPDFN,PACS,IOR,APR,I,PDFN
|
|---|
| 62 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 63 | S R="^^^^^"
|
|---|
| 64 | S T(1)="No Image ptr in AP"
|
|---|
| 65 | S T(2)="GP has no Images"
|
|---|
| 66 | S T(3)="Conflicting AP & Image DFNs"
|
|---|
| 67 | S T(4)="Invalid Image Ptr to AP"
|
|---|
| 68 | S T(5)="Conflicting GP and GO DFN"
|
|---|
| 69 | S T(6)="GP & GO AP Mismatch"
|
|---|
| 70 | S T(7)="GP Missing GO ptr"
|
|---|
| 71 | S T(8)="No AP Ptr"
|
|---|
| 72 | S T(9)="No AP Entry ptr"
|
|---|
| 73 | S T(10)="No AP Mult ptr"
|
|---|
| 74 | S T(11)="GO DFN mismatches"
|
|---|
| 75 | S T(12)="Null Image Ptr"
|
|---|
| 76 | S T(13)="Invalid Image Ptr"
|
|---|
| 77 | S T(14)="Invalid Image Ptr to AP"
|
|---|
| 78 | S T(15)="Image Entry is structurally abnormal"
|
|---|
| 79 | S T(16)="Missing Group Objects"
|
|---|
| 80 | S T(21)="DFN Mismatches in AP Image Mult"
|
|---|
| 81 | I IEN="" S $P(R,"^",5)=T(12)_"~1" Q R
|
|---|
| 82 | S X0=$G(^MAG(2005,IEN,0))
|
|---|
| 83 | I X0="" S $P(R,"^",5)=T(13)_"~1" Q R
|
|---|
| 84 | S IDFN=$P(X0,"^",7),$P(R,"^",4)=IDFN
|
|---|
| 85 | S PT(3.9)="^XMB(3.9,PD0,|Mail message||2|^XMB(3.9,PD0,2005,|MAIL"
|
|---|
| 86 | ; The following 5 Lab subsections must be in-synch with FILE+42^MAGGTLB1
|
|---|
| 87 | S PT(63)="^LR(PD0,GF,PD1,|Autopsy (microscopic)|AY|1|^LR(PD0,GF,PD1,2005,|AUM"
|
|---|
| 88 | S PT(63.02)="^LR(PD0,GF,PD1,|Electron microscopy|EM|1|^LR(PD0,GF,PD1,2005,|EM"
|
|---|
| 89 | S PT(63.08)="^LR(PD0,GF,PD1,|Surgical pathology|SP|1|^LR(PD0,GF,PD1,2005,|SP"
|
|---|
| 90 | S PT(63.09)="^LR(PD0,GF,PD1,|Cytology|CY|1|^LR(PD0,GF,PD1,2005,|CY|"
|
|---|
| 91 | S PT(63.2)="^LR(PD0,GF,PD1,|Autopsy (gross)|AY|1|^LR(PD0,GF,PD1,2005,|AUG"
|
|---|
| 92 | S PT(70)="^RADPT(PDFN,|Radiology Patient||1|"
|
|---|
| 93 | S PT(74)="^RARPT(PD0,|Radiology||2|^RARPT(PD0,2005,|RAD"
|
|---|
| 94 | S PT(130)="^SRF(PD0,|Surgery||1|^SRF(PD0,2005,|SUR"
|
|---|
| 95 | S PT(691)="^MCAR(691,PD0,|Echocardiogram||2|^MCAR(691,PD0,2005,|ECHO"
|
|---|
| 96 | S PT(691.1)="^MCAR(691.1,PD0,|Cardiac catheterization||2|^MCAR(691.1,PD0,2005,|CATH"
|
|---|
| 97 | S PT(691.5)="^MCAR(691.5,PD0,|Electrocardiography||2|^MCAR(691.5,PD0,2005,|ECG"
|
|---|
| 98 | S PT(694)="^MCAR(694,PD0,|Hematology||2|^MCAR(694,PD0,2005,|HEM"
|
|---|
| 99 | S PT(699)="^MCAR(699,PD0,|Endoscopy||2|^MCAR(699,PD0,2005,|ENDO"
|
|---|
| 100 | S PT(699.5)="^MCAR(699.5,PD0,|Medicine||2|^MCAR(699.5,PD0,2005,|GEN"
|
|---|
| 101 | S PT(8925)="^TIU(8925,PD0,|TIU||2|^TIU(8925.91,""ADI"",PD0,|TIU"
|
|---|
| 102 | S IC=$$IC(IEN,.N0,.N2,.GPDFN),$P(R,U,6)=IC
|
|---|
| 103 | I IC="ER" S $P(R,U,5)=T(15)_"~1" Q R
|
|---|
| 104 | I IC["GP",'$O(^MAG(2005,IEN,1,0)) S $P(R,U,5)=T(2)_"~1" Q R
|
|---|
| 105 | D PF(IEN,IC,N0,.PF,.PD0,.PD1,.PD2,.PACS,.IOR,.APR)
|
|---|
| 106 | I "GP^GO"[IC D Q:$P(R,U,5)'="" R
|
|---|
| 107 | . S I=0
|
|---|
| 108 | . F S I=$O(^MAG(2005,IOR,1,I)) Q:I'?1N.N D
|
|---|
| 109 | . . I '$D(^MAG(2005,$P($G(^MAG(2005,IOR,1,I,0)),U),0)) S $P(R,U,5)=T(16)_$S(IC="GO":"~2",1:"~1")
|
|---|
| 110 | . . Q
|
|---|
| 111 | I IC["GO" S $P(R,U,6)=$P(R,U,6)_"~"_IOR
|
|---|
| 112 | I PD2'?1N.N,(('PACS)&(PD0?1N.N)) S $P(R,U,5)=T(10)_$S(IC["GO":"~2",1:"~1") Q R
|
|---|
| 113 | I IC["GO" D Q:$P(R,U,5)'="" R
|
|---|
| 114 | . N I,J
|
|---|
| 115 | . S (I,J)=0
|
|---|
| 116 | . F S I=$O(^MAG(2005,IOR,1,I)) Q:I'?1N.N S:IEN=$P($G(^MAG(2005,IOR,1,I,0)),U,1) J=1
|
|---|
| 117 | . S:J=0 $P(R,U,5)=T(7)_"~2"
|
|---|
| 118 | . Q
|
|---|
| 119 | I IC["GO",IDFN'=GPDFN S $P(R,U,5)=T(5)_"~1",$P(R,U,3)=GPDFN Q R
|
|---|
| 120 | I IC["GO" D Q:$P(R,U,5)'="" R
|
|---|
| 121 | . N I,J
|
|---|
| 122 | . S I=0
|
|---|
| 123 | . F S I=$O(^MAG(2005,IOR,1,I)) Q:I'?1N.N D Q:$P(R,U,5)'=""
|
|---|
| 124 | . . S J=$P($G(^MAG(2005,IOR,1,I,0)),U)
|
|---|
| 125 | . . I $P($G(^MAG(2005,J,0)),U,7)'=IDFN S $P(R,U,5)=T(11)_"~2",$P(R,U,3)=$P($G(^MAG(2005,J,0)),U,7)
|
|---|
| 126 | . . Q
|
|---|
| 127 | I IC["GO",PACS,(($P(N2,U,6,7)'="")&($P(N2,U,6,7)'="^")),$P(N2,U,6,7)'=$P($G(^MAG(2005,$P(N0,U,10),2)),U,6,7) D Q R
|
|---|
| 128 | . S $P(R,U,5)=T(6)_"~1",$P(R,U,3)=$P(^MAG(2005,IOR,0),U,7) Q
|
|---|
| 129 | I (PF\1=63),PD1'?1N.N,PD1'?1N.N1"."1N.N Q R
|
|---|
| 130 | I PF?1N.E,$D(PT(+PF)),PD0?1N.N D
|
|---|
| 131 | . S $P(R,"^",2)=$P(PT(PF),"|",6)_"~"_PD0
|
|---|
| 132 | . S GR=$P(PT(PF),"|",1),GR0=GR_"0)"
|
|---|
| 133 | . S GF=$P(PT(PF),"|",3),GP=$P(PT(PF),"|",4)
|
|---|
| 134 | . S T=$P(PT(PF),"|",5),GRD=T_"G0,0)",GRG=T_"G0)"
|
|---|
| 135 | E D Q R
|
|---|
| 136 | . S:((IC["GP")&($P(R,U,5)="")) $P(R,U,5)="1"
|
|---|
| 137 | S P0=$G(@GR0)
|
|---|
| 138 | I P0="" S $P(R,"^",5)=T(4)_$S((('PACS)&(IC["GO")):"~2",1:"~1") Q R
|
|---|
| 139 | S PDFN=$S(PF\1=63:$P(^LR(PD0,0),U,3),$P(P0,"^",GP)'="":$P(P0,"^",GP),1:PDFN)
|
|---|
| 140 | I 'PDFN,$P($G(^VA(200,IDFN,0)),"^",1)=PDFN S PDFN=IDFN
|
|---|
| 141 | S $P(R,"^",3)=PDFN
|
|---|
| 142 | I PDFN'=IDFN S $P(R,U,5)=T(3)_$S((('PACS)&(IC["GO")):"~2",1:"~1") Q R
|
|---|
| 143 | I PF=74 D
|
|---|
| 144 | . S GR=$P(PT(70),"|",1),GR0=GR_"0)"
|
|---|
| 145 | . S GF=$P(PT(70),"|",3),GP=$P(PT(70),"|",4)
|
|---|
| 146 | . S P0=$G(@GR0),$P(R,"^",3)=$P(R,"^",3)_"~"_$P(P0,"^",GP)
|
|---|
| 147 | S T=1,G0=0,IENV=0
|
|---|
| 148 | F S G0=$O(@GRG) Q:'G0 Q:$P(R,U,5)'="" D I 'T K PT Q
|
|---|
| 149 | . I PF=8925 D Q
|
|---|
| 150 | . . I '$D(^MAG(2005,+G0,0)) S $P(R,U,5)=T(14)_$S((('PACS)&(IC["GO")):"~2",1:"~1")
|
|---|
| 151 | . . S:G0=IOR IENV=1
|
|---|
| 152 | . . I $P($G(^MAG(2005,+G0,0)),"^",7)'=IDFN S $P(R,U,5)=T(21)_"~2",$P(R,U,3)=$P($G(^MAG(2005,+G0,0)),"^",7)
|
|---|
| 153 | . . Q
|
|---|
| 154 | . I '$D(^MAG(2005,+$P($G(@GRD),"^",1),0)) S $P(R,U,5)=T(14)_$S((('PACS)&(IC["GO")):"~2",1:"~1")
|
|---|
| 155 | . I $P($G(^MAG(2005,+$P($G(@GRD),"^",1),0)),"^",7)'=IDFN D Q
|
|---|
| 156 | . . S $P(R,U,5)=T(21)_"~2",$P(R,U,3)=$P($G(^MAG(2005,+$P($G(@GRD),"^",1),0)),"^",7) Q
|
|---|
| 157 | . I PF=63 S:+$P($G(^LR(PD0,GF,PD1,2005.1,G0,0)),U)=IOR IENV=1
|
|---|
| 158 | . I PF=63.2 S:+$P($G(^LR(PD0,GF,PD1,2005,G0,0)),U)=IOR IENV=1
|
|---|
| 159 | . S:+$P($G(@GRD),"^",1)=IOR IENV=1
|
|---|
| 160 | . Q
|
|---|
| 161 | Q:$P(R,U,5)'="" R
|
|---|
| 162 | I IC["GP" S $P(R,U,5)="1"
|
|---|
| 163 | I IENV=0 S $P(R,U,5)=T(1)_"~1"
|
|---|
| 164 | I PF=74 S $P(R,"^",1)=$P(P0,"^",1)
|
|---|
| 165 | K PT
|
|---|
| 166 | Q R
|
|---|
| 167 | IC(IEN,N0,N2,GPDFN) ;
|
|---|
| 168 | S N0=$G(^MAG(2005,IEN,0))
|
|---|
| 169 | S N1=$G(^MAG(2005,IEN,1,0))
|
|---|
| 170 | S N2=$G(^MAG(2005,IEN,2))
|
|---|
| 171 | I ($P(N0,U,2)="")&($P(N0,U,10)="")&($P(N1,U,4)>0) Q "GP"
|
|---|
| 172 | I (($P(N0,U,2)'="")&($P(N0,U,10)?1N.N)&(N1="")) D Q "GO"
|
|---|
| 173 | . S GPDFN=$P($G(^MAG(2005,$P(N0,U,10),0)),U,7) Q
|
|---|
| 174 | I ($P(N0,U,2)'="")&($P(N0,U,10)'?1N.N)&(N1="") Q "NG"
|
|---|
| 175 | Q "ER"
|
|---|
| 176 | PF(IEN,IC,N0,PF,PD0,PD1,PD2,PACS,IOR,APR) ;
|
|---|
| 177 | N N2
|
|---|
| 178 | S PACS=$S($D(^MAG(2005,IEN,"PACS")):1,1:0)
|
|---|
| 179 | S IOR=$S(IC="GO":$P($G(N0),U,10),1:IEN)
|
|---|
| 180 | I ((IC="GP")!(IC="NG")!((PACS)&(IC="GO"))) S N2=$G(^MAG(2005,IEN,2))
|
|---|
| 181 | I ((IC="GO")&('PACS)) S N2=$G(^MAG(2005,IOR,2))
|
|---|
| 182 | S PF=$P(N2,"^",6),PD0=$P(N2,"^",7),PD1=$P(N2,"^",10),PD2=$P(N2,"^",8)
|
|---|
| 183 | I PACS S APR=$S(PD0?1N.N:1,1:0)
|
|---|
| 184 | E S APR=$S(((PF'="")&(PD0?1N.N)):1,$P($G(^MAG(2005,IOR,100)),U)?1N.N:1,$P($G(^MAG(2005,IOR,0)),U,6)="18":1,1:0)
|
|---|
| 185 | Q
|
|---|
