- 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 Mar 13, 2025@21:02:52 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
