31 lines
1.3 KiB
Mathematica
31 lines
1.3 KiB
Mathematica
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
|