GMTSMAGE ;SLC/RMP - Imaging HS Comp Data Extraction ; 08/27/2002
;;2.7;Health Summary;**26,56**;Oct 20, 1995
;
; External References
; DBIA 2791 ^MAG(2005
;
IMGPTRE(ZY,MAGMESS) ; Return Image Info List for Patient
N MAX,Y,MAGDFN,MAGDUZ,CT,PD,T,I,P
S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
S MAGDFN=$P(MAGMESS,"^",1),MAGDUZ=$P(MAGMESS,"^",2) S:MAGDUZ="" MAGDUZ=0
F I=1:1:10 I $E(MAGDFN,1)=" " S MAGDFN=$E(MAGDFN,2,99)
S MAGDFN=+MAGDFN I '$D(^MAG(2005,"APDTPX",MAGDFN)) S ZY(0)="1^0" Q
S CT=0,T=0,I=0,P="",PD=""
F S PD=$O(^MAG(2005,"APDTPX",MAGDFN,PD)) Q:PD="" Q:'$$GT(PD) D
. S P="" F S P=$O(^MAG(2005,"APDTPX",MAGDFN,PD,P)) Q:P="" D
. . S I="" F S I=$O(^MAG(2005,"APDTPX",MAGDFN,PD,P,I)) Q:+I<1 D
. . . Q:$P($G(^MAG(2005,I,0)),"^",10) ; Child of Group
. . . S T=T+1 Q:T>250 Q:(MAX>1)&(MAX<(CT+1)) S CT=CT+1
. . . D ARRY(.ZY,CT,I)
S ZY(0)="1^"_CT S:T>CT ZY(0)=ZY(0)_" of "_T K T,I
Q
GT(ADT) ; Date Range Check
Q:ADT>GMTS2 0
Q $S(ADT>GMTS1:1,1:0)
ARRY(ZY,CT,I) ; Build Array
S ZY(CT)=$P(^MAG(2005,I,2),"^",5)
S $P(ZY(CT),"^",2)=$P(^MAG(2005,I,0),"^",8)
S $P(ZY(CT),"^",3)=$P(^MAG(2005,I,2),"^",4)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSMAGE 1217 printed Nov 22, 2024@17:08:12 Page 2
GMTSMAGE ;SLC/RMP - Imaging HS Comp Data Extraction ; 08/27/2002
+1 ;;2.7;Health Summary;**26,56**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 2791 ^MAG(2005
+5 ;
IMGPTRE(ZY,MAGMESS) ; Return Image Info List for Patient
+1 NEW MAX,Y,MAGDFN,MAGDUZ,CT,PD,T,I,P
+2 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
+3 SET MAGDFN=$PIECE(MAGMESS,"^",1)
SET MAGDUZ=$PIECE(MAGMESS,"^",2)
if MAGDUZ=""
SET MAGDUZ=0
+4 FOR I=1:1:10
IF $EXTRACT(MAGDFN,1)=" "
SET MAGDFN=$EXTRACT(MAGDFN,2,99)
+5 SET MAGDFN=+MAGDFN
IF '$DATA(^MAG(2005,"APDTPX",MAGDFN))
SET ZY(0)="1^0"
QUIT
+6 SET CT=0
SET T=0
SET I=0
SET P=""
SET PD=""
+7 FOR
SET PD=$ORDER(^MAG(2005,"APDTPX",MAGDFN,PD))
if PD=""
QUIT
if '$$GT(PD)
QUIT
Begin DoDot:1
+8 SET P=""
FOR
SET P=$ORDER(^MAG(2005,"APDTPX",MAGDFN,PD,P))
if P=""
QUIT
Begin DoDot:2
+9 SET I=""
FOR
SET I=$ORDER(^MAG(2005,"APDTPX",MAGDFN,PD,P,I))
if +I<1
QUIT
Begin DoDot:3
+10 ; Child of Group
if $PIECE($GET(^MAG(2005,I,0)),"^",10)
QUIT
+11 SET T=T+1
if T>250
QUIT
if (MAX>1)&(MAX<(CT+1))
QUIT
SET CT=CT+1
+12 DO ARRY(.ZY,CT,I)
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET ZY(0)="1^"_CT
if T>CT
SET ZY(0)=ZY(0)_" of "_T
KILL T,I
+14 QUIT
GT(ADT) ; Date Range Check
+1 if ADT>GMTS2
QUIT 0
+2 QUIT $SELECT(ADT>GMTS1:1,1:0)
ARRY(ZY,CT,I) ; Build Array
+1 SET ZY(CT)=$PIECE(^MAG(2005,I,2),"^",5)
+2 SET $PIECE(ZY(CT),"^",2)=$PIECE(^MAG(2005,I,0),"^",8)
+3 SET $PIECE(ZY(CT),"^",3)=$PIECE(^MAG(2005,I,2),"^",4)
+4 QUIT
