GMTSMAGE.m

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

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