MAGDQR09 ;WOIFO/EDM,MLH,NST,BT,PMK - Imaging RPCs for Query/Retrieve ; Feb 15, 2022@10:26:14
;;3.0;IMAGING;**118,305**;Mar 19, 2002;Build 3
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | 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
; Overflows from MAGDQR03
Q020000D(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Study Instance UID
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. S V(T)="1.2.840.113754.2.1.3.1.1.66."_$G(^TMP("MAG",$J,"DICOMQR","DUMMY SIUID"))
. Q
; no
S V(T)="" Q:'MAGIEN
D ; retrieve from old or new DB?
. N PARENT
. I TYPE'="N" D Q
. . N PARENT
. . S PARENT=$P($G(^MAG(2005,MAGIEN,0)),"^",10)
. . S:'PARENT PARENT=MAGIEN
. . S V(T)=$P($G(^MAG(2005,PARENT,"PACS")),"^",1)
. . Q
. I TYPE="N" D Q
. . S PARENT=$P($G(^MAGV(2005.64,MAGIEN,6)),"^",1) I 'PARENT Q
. . S PARENT=$P($G(^MAGV(2005.63,PARENT,6)),"^",1) I 'PARENT Q
. . S V(T)=$P($G(^MAGV(2005.62,PARENT,0)),"^",1)
. . Q
. Q
Q
;
Q020000E(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Series Instance UID
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. S V(T)="1.2.840.113754.2.1.3.1.1.1.66."_$G(^TMP("MAG",$J,"DICOMQR","DUMMY SIUID"))
. Q
; no
D ; retrieve from old or new DB?
. N PARENT
. I TYPE'="N" D Q
. . I MAGIEN="" S V(T)="" Q
. . S V(T)=$P($G(^MAG(2005,MAGIEN,"SERIESUID")),"^",1)
. . Q
. I TYPE="N" D Q
. . S PARENT=$P($G(^MAGV(2005.64,MAGIEN,6)),"^",1) I 'PARENT Q
. . S V(T)=$P($G(^MAGV(2005.63,PARENT,0)),"^",1)
. . Q
. Q
Q
;
Q0080061(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Modalities in Study
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I
. S I=$O(REQ(T,""))
. S V(T)="OT" I I,$G(REQ(T,I))]"" S V(T)=REQ(T,I)
. Q
; no
N ANY,I1,I2,LIST,MOD,P1,P2,R,TMP,PARENT,I,X
I MAGIEN="" S V(T)="" Q
;
S I1="" F S I1=$O(REQ(T,I1)) Q:I1="" D
. S R=$TR(REQ(T,I1),"/","\")
. F I2=1:1:$L(R,"\") S X=$P(R,"\",I2) S:X'="" LIST(X)=1
. Q
;
; select based on old/new DB
I TYPE="N" D NSTYMOD(MAGIEN,.MOD)
I (TYPE="C")!(TYPE="R") D STYMOD(MAGIEN,.MOD)
;
; return only the requested Modalities
S R="",ANY=0,X=""
F S X=$O(MOD(X)) Q:X="" D
. D ; filter out consult-related noise
. . Q:$E(X,1,7)="CONSULT" Q:X="CON/PROC"
. . S:R'="" R=R_"," S R=R_X
. . Q
. I $O(LIST(""))="" S ANY=1 Q
. S I1="" F S I1=$O(LIST(I1)) Q:I1="" D Q:ANY
. . S:$$MATCHD^MAGDQR03(X,"LIST(LOOP)","TMP(LOOP)") ANY=1
. . Q
. Q
S V(T)=R
I 'ANY,$D(LIST) S OK=0 ; no matches
Q
;
;given MAGIEN, save all study's modalities (New DB) to MOD array
NSTYMOD(MAGIEN,MOD) ;
N SERREF,STYREF,D0,MODS,I,MODITEM
S SERREF=$P($G(^MAGV(2005.64,MAGIEN,6)),"^",1) I 'SERREF Q
S STYREF=$P($G(^MAGV(2005.63,SERREF,6)),"^",1) I 'STYREF Q
S D0=0
F S D0=$O(^MAGV(2005.63,"C",STYREF,D0)) Q:'D0 D
. S MODS=$P($G(^MAGV(2005.63,D0,1)),"^",1)
. F I=1:1:$L(MODS,"/") S MODITEM=$P(MODS,"/",I) S:$L(MODITEM) MOD(MODITEM)=""
Q
;
;given MAGIEN, save all study's modalities (Old/legacy DB) to MOD array
STYMOD(MAGIEN,MOD) ;
N STUDYUID,X,R,P1,P2
S STUDYUID=$P($G(^MAG(2005,MAGIEN,"PACS")),"^",1) Q:STUDYUID=""
S MAGIEN=0
F S MAGIEN=$O(^MAG(2005,"P",STUDYUID,MAGIEN)) Q:'MAGIEN D
. S X=$P($G(^MAG(2005,MAGIEN,0)),"^",8)
. S:$E(X,1,4)="RAD " X=$E(X,5,$L(X))
. S:X'="" MOD(X)=""
. S R="",P1=0
. F S P1=$O(^MAG(2005,MAGIEN,1,P1)) Q:'P1 D
. . S P2=+$G(^MAG(2005,MAGIEN,1,P1,0)) Q:'P2
. . S X=$P($G(^MAG(2005,P2,0)),"^",8)
. . S:$E(X,1,4)="RAD " X=$E(X,5,$L(X))
. . S:X'="" MOD(X)=""
. . Q
. Q
Q
;
Q0201206(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Series
; sensitive/employee?
I $G(SENSEMP) D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
N N,S,UID
S UID=$G(V("0020,000D")),N=0
D:UID'="" ; select based on old/new type
. I TYPE="N" D Q ; new P34 DB
. . N STYIX,SERIX
. . S STYIX=0
. . F S STYIX=$O(^MAGV(2005.62,"B",UID,STYIX)) Q:STYIX="" D
. . . I $$PROBLEM62^MAGDSTA8(STYIX) Q ; P305 PMK 12/06/2021
. . . ; Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)'="A" ; inaccessible status
. . . S SERIX=0
. . . F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
. . . . I $$PROBLEM63^MAGDSTA8(SERIX) Q ; P305 PMK 12/06/2021
. . . . ; S:$P($G(^MAGV(2005.63,SERIX,9)),"^",1)="A" N=N+1 ; accessible status
. . . . S N=N+1
. . . . Q
. . . Q
. . Q
. I (TYPE="R")!(TYPE="C") D Q ; legacy DB
. . S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" S N=N+1
. . Q
. Q
S V(T)=N
S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q0201208(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Instances
; sensitive/employee?
I $G(SENSEMP) D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
N N,P1,P2,S,UID
S UID=$G(V("0020,000D")),N=0
D:UID'="" ; select based on old / new type
. I TYPE="N" D Q
. . N STYIX,SERIX,SOPIX
. . S STYIX=0
. . F S STYIX=$O(^MAGV(2005.62,"B",UID,STYIX)) Q:STYIX="" D
. . . I $$PROBLEM62^MAGDSTA8(STYIX) Q ; P305 PMK 12/06/2021
. . . ; Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)'="A" ; inaccessible status
. . . S SERIX=0
. . . F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
. . . . I $$PROBLEM63^MAGDSTA8(SERIX) Q ; P305 PMK 12/06/2021
. . . . ; Q:$P($G(^MAGV(2005.63,SERIX,9)),"^",1)'="A" ; inaccessible status
. . . . S SOPIX=0
. . . . F S SOPIX=$O(^MAGV(2005.64,"C",SERIX,SOPIX)) Q:'SOPIX D
. . . . . I $$PROBLEM64^MAGDSTA8(SOPIX) Q ; P305 PMK 12/06/2021
. . . . . ; S:$P($G(^MAGV(2005.64,SOPIX,11)),"^",1)="A" N=N+1 ; accessible status
. . . . . S N=N+1
. . . . . Q
. . . . Q
. . . Q
. . Q
. I (TYPE="R")!(TYPE="C") D Q
. . S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" D
. . . S P1=0 F S P1=$O(^MAG(2005,S,1,P1)) Q:'P1 D
. . . . S P2=+$G(^MAG(2005,S,1,P1,0)) Q:'P2
. . . . S N=N+1
. . . . Q
. . . Q
. . Q
. Q
S V(T)=N
S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR09 6998 printed Oct 16, 2024@18:01:41 Page 2
MAGDQR09 ;WOIFO/EDM,MLH,NST,BT,PMK - Imaging RPCs for Query/Retrieve ; Feb 15, 2022@10:26:14
+1 ;;3.0;IMAGING;**118,305**;Mar 19, 2002;Build 3
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | 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 ; Overflows from MAGDQR03
Q020000D(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Study Instance UID
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 SET V(T)="1.2.840.113754.2.1.3.1.1.66."_$GET(^TMP("MAG",$JOB,"DICOMQR","DUMMY SIUID"))
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 SET V(T)=""
if 'MAGIEN
QUIT
+7 ; retrieve from old or new DB?
Begin DoDot:1
+8 NEW PARENT
+9 IF TYPE'="N"
Begin DoDot:2
+10 NEW PARENT
+11 SET PARENT=$PIECE($GET(^MAG(2005,MAGIEN,0)),"^",10)
+12 if 'PARENT
SET PARENT=MAGIEN
+13 SET V(T)=$PIECE($GET(^MAG(2005,PARENT,"PACS")),"^",1)
+14 QUIT
End DoDot:2
QUIT
+15 IF TYPE="N"
Begin DoDot:2
+16 SET PARENT=$PIECE($GET(^MAGV(2005.64,MAGIEN,6)),"^",1)
IF 'PARENT
QUIT
+17 SET PARENT=$PIECE($GET(^MAGV(2005.63,PARENT,6)),"^",1)
IF 'PARENT
QUIT
+18 SET V(T)=$PIECE($GET(^MAGV(2005.62,PARENT,0)),"^",1)
+19 QUIT
End DoDot:2
QUIT
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
Q020000E(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Series Instance UID
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 SET V(T)="1.2.840.113754.2.1.3.1.1.1.66."_$GET(^TMP("MAG",$JOB,"DICOMQR","DUMMY SIUID"))
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 ; retrieve from old or new DB?
Begin DoDot:1
+7 NEW PARENT
+8 IF TYPE'="N"
Begin DoDot:2
+9 IF MAGIEN=""
SET V(T)=""
QUIT
+10 SET V(T)=$PIECE($GET(^MAG(2005,MAGIEN,"SERIESUID")),"^",1)
+11 QUIT
End DoDot:2
QUIT
+12 IF TYPE="N"
Begin DoDot:2
+13 SET PARENT=$PIECE($GET(^MAGV(2005.64,MAGIEN,6)),"^",1)
IF 'PARENT
QUIT
+14 SET V(T)=$PIECE($GET(^MAGV(2005.63,PARENT,0)),"^",1)
+15 QUIT
End DoDot:2
QUIT
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
Q0080061(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Modalities in Study
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
+4 SET I=$ORDER(REQ(T,""))
+5 SET V(T)="OT"
IF I
IF $GET(REQ(T,I))]""
SET V(T)=REQ(T,I)
+6 QUIT
End DoDot:1
QUIT
+7 ; no
+8 NEW ANY,I1,I2,LIST,MOD,P1,P2,R,TMP,PARENT,I,X
+9 IF MAGIEN=""
SET V(T)=""
QUIT
+10 ;
+11 SET I1=""
FOR
SET I1=$ORDER(REQ(T,I1))
if I1=""
QUIT
Begin DoDot:1
+12 SET R=$TRANSLATE(REQ(T,I1),"/","\")
+13 FOR I2=1:1:$LENGTH(R,"\")
SET X=$PIECE(R,"\",I2)
if X'=""
SET LIST(X)=1
+14 QUIT
End DoDot:1
+15 ;
+16 ; select based on old/new DB
+17 IF TYPE="N"
DO NSTYMOD(MAGIEN,.MOD)
+18 IF (TYPE="C")!(TYPE="R")
DO STYMOD(MAGIEN,.MOD)
+19 ;
+20 ; return only the requested Modalities
+21 SET R=""
SET ANY=0
SET X=""
+22 FOR
SET X=$ORDER(MOD(X))
if X=""
QUIT
Begin DoDot:1
+23 ; filter out consult-related noise
Begin DoDot:2
+24 if $EXTRACT(X,1,7)="CONSULT"
QUIT
if X="CON/PROC"
QUIT
+25 if R'=""
SET R=R_","
SET R=R_X
+26 QUIT
End DoDot:2
+27 IF $ORDER(LIST(""))=""
SET ANY=1
QUIT
+28 SET I1=""
FOR
SET I1=$ORDER(LIST(I1))
if I1=""
QUIT
Begin DoDot:2
+29 if $$MATCHD^MAGDQR03(X,"LIST(LOOP)","TMP(LOOP)")
SET ANY=1
+30 QUIT
End DoDot:2
if ANY
QUIT
+31 QUIT
End DoDot:1
+32 SET V(T)=R
+33 ; no matches
IF 'ANY
IF $DATA(LIST)
SET OK=0
+34 QUIT
+35 ;
+36 ;given MAGIEN, save all study's modalities (New DB) to MOD array
NSTYMOD(MAGIEN,MOD) ;
+1 NEW SERREF,STYREF,D0,MODS,I,MODITEM
+2 SET SERREF=$PIECE($GET(^MAGV(2005.64,MAGIEN,6)),"^",1)
IF 'SERREF
QUIT
+3 SET STYREF=$PIECE($GET(^MAGV(2005.63,SERREF,6)),"^",1)
IF 'STYREF
QUIT
+4 SET D0=0
+5 FOR
SET D0=$ORDER(^MAGV(2005.63,"C",STYREF,D0))
if 'D0
QUIT
Begin DoDot:1
+6 SET MODS=$PIECE($GET(^MAGV(2005.63,D0,1)),"^",1)
+7 FOR I=1:1:$LENGTH(MODS,"/")
SET MODITEM=$PIECE(MODS,"/",I)
if $LENGTH(MODITEM)
SET MOD(MODITEM)=""
End DoDot:1
+8 QUIT
+9 ;
+10 ;given MAGIEN, save all study's modalities (Old/legacy DB) to MOD array
STYMOD(MAGIEN,MOD) ;
+1 NEW STUDYUID,X,R,P1,P2
+2 SET STUDYUID=$PIECE($GET(^MAG(2005,MAGIEN,"PACS")),"^",1)
if STUDYUID=""
QUIT
+3 SET MAGIEN=0
+4 FOR
SET MAGIEN=$ORDER(^MAG(2005,"P",STUDYUID,MAGIEN))
if 'MAGIEN
QUIT
Begin DoDot:1
+5 SET X=$PIECE($GET(^MAG(2005,MAGIEN,0)),"^",8)
+6 if $EXTRACT(X,1,4)="RAD "
SET X=$EXTRACT(X,5,$LENGTH(X))
+7 if X'=""
SET MOD(X)=""
+8 SET R=""
SET P1=0
+9 FOR
SET P1=$ORDER(^MAG(2005,MAGIEN,1,P1))
if 'P1
QUIT
Begin DoDot:2
+10 SET P2=+$GET(^MAG(2005,MAGIEN,1,P1,0))
if 'P2
QUIT
+11 SET X=$PIECE($GET(^MAG(2005,P2,0)),"^",8)
+12 if $EXTRACT(X,1,4)="RAD "
SET X=$EXTRACT(X,5,$LENGTH(X))
+13 if X'=""
SET MOD(X)=""
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
Q0201206(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Series
+1 ; sensitive/employee?
+2 ; yes, scrub
IF $GET(SENSEMP)
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 NEW N,S,UID
+7 SET UID=$GET(V("0020,000D"))
SET N=0
+8 ; select based on old/new type
if UID'=""
Begin DoDot:1
+9 ; new P34 DB
IF TYPE="N"
Begin DoDot:2
+10 NEW STYIX,SERIX
+11 SET STYIX=0
+12 FOR
SET STYIX=$ORDER(^MAGV(2005.62,"B",UID,STYIX))
if STYIX=""
QUIT
Begin DoDot:3
+13 ; P305 PMK 12/06/2021
IF $$PROBLEM62^MAGDSTA8(STYIX)
QUIT
+14 ; Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)'="A" ; inaccessible status
+15 SET SERIX=0
+16 FOR
SET SERIX=$ORDER(^MAGV(2005.63,"C",STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:4
+17 ; P305 PMK 12/06/2021
IF $$PROBLEM63^MAGDSTA8(SERIX)
QUIT
+18 ; S:$P($G(^MAGV(2005.63,SERIX,9)),"^",1)="A" N=N+1 ; accessible status
+19 SET N=N+1
+20 QUIT
End DoDot:4
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
QUIT
+23 ; legacy DB
IF (TYPE="R")!(TYPE="C")
Begin DoDot:2
+24 SET S=""
FOR
SET S=$ORDER(^MAG(2005,"P",UID,S))
if S=""
QUIT
SET N=N+1
+25 QUIT
End DoDot:2
QUIT
+26 QUIT
End DoDot:1
+27 SET V(T)=N
+28 if '$$COMPARE^MAGDQR03(T,V(T))
SET OK=0
+29 QUIT
+30 ;
Q0201208(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Instances
+1 ; sensitive/employee?
+2 ; yes, scrub
IF $GET(SENSEMP)
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 NEW N,P1,P2,S,UID
+7 SET UID=$GET(V("0020,000D"))
SET N=0
+8 ; select based on old / new type
if UID'=""
Begin DoDot:1
+9 IF TYPE="N"
Begin DoDot:2
+10 NEW STYIX,SERIX,SOPIX
+11 SET STYIX=0
+12 FOR
SET STYIX=$ORDER(^MAGV(2005.62,"B",UID,STYIX))
if STYIX=""
QUIT
Begin DoDot:3
+13 ; P305 PMK 12/06/2021
IF $$PROBLEM62^MAGDSTA8(STYIX)
QUIT
+14 ; Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)'="A" ; inaccessible status
+15 SET SERIX=0
+16 FOR
SET SERIX=$ORDER(^MAGV(2005.63,"C",STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:4
+17 ; P305 PMK 12/06/2021
IF $$PROBLEM63^MAGDSTA8(SERIX)
QUIT
+18 ; Q:$P($G(^MAGV(2005.63,SERIX,9)),"^",1)'="A" ; inaccessible status
+19 SET SOPIX=0
+20 FOR
SET SOPIX=$ORDER(^MAGV(2005.64,"C",SERIX,SOPIX))
if 'SOPIX
QUIT
Begin DoDot:5
+21 ; P305 PMK 12/06/2021
IF $$PROBLEM64^MAGDSTA8(SOPIX)
QUIT
+22 ; S:$P($G(^MAGV(2005.64,SOPIX,11)),"^",1)="A" N=N+1 ; accessible status
+23 SET N=N+1
+24 QUIT
End DoDot:5
+25 QUIT
End DoDot:4
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
QUIT
+28 IF (TYPE="R")!(TYPE="C")
Begin DoDot:2
+29 SET S=""
FOR
SET S=$ORDER(^MAG(2005,"P",UID,S))
if S=""
QUIT
Begin DoDot:3
+30 SET P1=0
FOR
SET P1=$ORDER(^MAG(2005,S,1,P1))
if 'P1
QUIT
Begin DoDot:4
+31 SET P2=+$GET(^MAG(2005,S,1,P1,0))
if 'P2
QUIT
+32 SET N=N+1
+33 QUIT
End DoDot:4
+34 QUIT
End DoDot:3
+35 QUIT
End DoDot:2
QUIT
+36 QUIT
End DoDot:1
+37 SET V(T)=N
+38 if '$$COMPARE^MAGDQR03(T,V(T))
SET OK=0
+39 QUIT
