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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRACMR3 1394 printed Nov 22, 2024@16:48:58 Page 2
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
