GMRACMR3.m

GMRACMR3 ;HIRMFO/RM,WAA-PATIENT CENSUS CALCULATION ; 10/9/92

 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EN1 ;FINDS ALL PATIENTS WHO HAVE BEEN ADMITTED WITH IN A DATE RANGE

 I GMRASEL["3" F GMRADATE=(GMRAST-.0000001):0 S GMRADATE=$O(^DGPM("AMV1",GMRADATE)) Q:GMRADATE'>0!(GMRADATE>GMRAED)  D

 .F GMRADFN=0:0 S GMRADFN=$O(^DGPM("AMV1",GMRADATE,GMRADFN)) Q:GMRADFN'>0  F GMRAMOV=0:0 S GMRAMOV=$O(^DGPM("AMV1",GMRADATE,GMRADFN,GMRAMOV)) Q:GMRAMOV'>0  D

 ..S WLOC=$P($G(^DGPM(GMRAMOV,0)),"^",6),HLOC=+$G(^DIC(42,+WLOC,44)) Q:'HLOC

 ..S GMRAX=HLOC D SETPT

 ..Q

 .Q

EN2 ;THIS WILL FIND ALL CURRENT PATIENTS

 I GMRASEL["1" D

 .S GMRAX=0

 .F  S GMRAX=$O(^TMP($J,"GMRAWC",GMRAX)) Q:GMRAX<1  D

 ..S WLOC=$G(^SC(GMRAX,42)) Q:+WLOC<1

 ..S HLOC=$P($G(^DIC(42,+WLOC,0)),U) Q:HLOC=""

 ..S GMRADFN=0 N GMRADT F  S GMRADFN=$O(^DPT("CN",HLOC,GMRADFN)) Q:GMRADFN<1  S GMRADATE="CURRENT" D SETPT

 ..Q

 .Q

 K GMRADATE,GMRAX,GMRANUM,HLOC,WLOC,GMRADFN,GMRAMOV Q

SETPT ;This entry point is to set the patient data in the TMP global.

 N GMRATMP

 I '$D(^TMP($J,"GMRAWC",GMRAX)) Q

 I $D(^TMP($J,"GMRAWC","B",GMRADFN,GMRAX)) Q

 S ^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)=""

 S ^TMP($J,"GMRAWC","B",GMRADFN,GMRAX)=""

 S GMRATMP(1)=$P(^SC(GMRAX,0),U,2)

 S GMRATMP(2)=$P(^SC(GMRAX,0),U)

 S GMRATMP(3)=$S(GMRATMP(1)'="":GMRATMP(1),1:GMRATMP(2))

 S ^TMP($J,"GMRAWC","C",GMRATMP(3),GMRAX)=""

 Q

GMRACMR3  ;HIRMFO/RM,WAA-PATIENT CENSUS CALCULATION ; 10/9/92

 +1       ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996

EN1       ;FINDS ALL PATIENTS WHO HAVE BEEN ADMITTED WITH IN A DATE RANGE

 +1        IF GMRASEL["3"

               FOR GMRADATE=(GMRAST-.0000001):0

                   SET GMRADATE=$ORDER(^DGPM("AMV1",GMRADATE))

                   IF GMRADATE'>0!(GMRADATE>GMRAED)

                       QUIT 

                   Begin DoDot:1

 +2                    FOR GMRADFN=0:0

                           SET GMRADFN=$ORDER(^DGPM("AMV1",GMRADATE,GMRADFN))

                           IF GMRADFN'>0

                               QUIT 

                           FOR GMRAMOV=0:0

                               SET GMRAMOV=$ORDER(^DGPM("AMV1",GMRADATE,GMRADFN,GMRAMOV))

                               IF GMRAMOV'>0

                                   QUIT 

                               Begin DoDot:2

 +3                                SET WLOC=$PIECE($GET(^DGPM(GMRAMOV,0)),"^",6)

                                   SET HLOC=+$GET(^DIC(42,+WLOC,44))

                                   IF 'HLOC

                                       QUIT 

 +4                                SET GMRAX=HLOC

                                   DO SETPT

 +5                                QUIT 

                               End DoDot:2

 +6                    QUIT 

                   End DoDot:1

EN2       ;THIS WILL FIND ALL CURRENT PATIENTS

 +1        IF GMRASEL["1"

               Begin DoDot:1

 +2                SET GMRAX=0

 +3                FOR 

                       SET GMRAX=$ORDER(^TMP($JOB,"GMRAWC",GMRAX))

                       IF GMRAX<1

                           QUIT 

                       Begin DoDot:2

 +4                        SET WLOC=$GET(^SC(GMRAX,42))

                           IF +WLOC<1

                               QUIT 

 +5                        SET HLOC=$PIECE($GET(^DIC(42,+WLOC,0)),U)

                           IF HLOC=""

                               QUIT 

 +6                        SET GMRADFN=0

                           NEW GMRADT

                           FOR 

                               SET GMRADFN=$ORDER(^DPT("CN",HLOC,GMRADFN))

                               IF GMRADFN<1

                                   QUIT 

                               SET GMRADATE="CURRENT"

                               DO SETPT

 +7                        QUIT 

                       End DoDot:2

 +8                QUIT 

               End DoDot:1

 +9        KILL GMRADATE,GMRAX,GMRANUM,HLOC,WLOC,GMRADFN,GMRAMOV

           QUIT 

SETPT     ;This entry point is to set the patient data in the TMP global.

 +1        NEW GMRATMP

 +2        IF '$DATA(^TMP($JOB,"GMRAWC",GMRAX))

               QUIT 

 +3        IF $DATA(^TMP($JOB,"GMRAWC","B",GMRADFN,GMRAX))

               QUIT 

 +4        SET ^TMP($JOB,"GMRAWC",GMRAX,GMRADATE,GMRADFN)=""

 +5        SET ^TMP($JOB,"GMRAWC","B",GMRADFN,GMRAX)=""

 +6        SET GMRATMP(1)=$PIECE(^SC(GMRAX,0),U,2)

 +7        SET GMRATMP(2)=$PIECE(^SC(GMRAX,0),U)

 +8        SET GMRATMP(3)=$SELECT(GMRATMP(1)'="":GMRATMP(1),1:GMRATMP(2))

 +9        SET ^TMP($JOB,"GMRAWC","C",GMRATMP(3),GMRAX)=""

 +10       QUIT