31 lines
1.3 KiB
Mathematica
31 lines
1.3 KiB
Mathematica
SPNCMR3 ;HIRMFO/RM,WAA-PATIENT CENSUS CALCULATION ; 10/9/92
|
|
;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|
EN1 ;FINDS ALL PATIENTS WHO HAVE BEEN ADMITTED WITH IN A DATE RANGE
|
|
I SPNSEL["3" F SPNDATE=(SPNST-.0000001):0 S SPNDATE=$O(^DGPM("AMV1",SPNDATE)) Q:SPNDATE'>0!(SPNDATE>SPNED) D
|
|
.F SPNDFN=0:0 S SPNDFN=$O(^DGPM("AMV1",SPNDATE,SPNDFN)) Q:SPNDFN'>0 F SPNMOV=0:0 S SPNMOV=$O(^DGPM("AMV1",SPNDATE,SPNDFN,SPNMOV)) Q:SPNMOV'>0 D
|
|
..S WLOC=$P($G(^DGPM(SPNMOV,0)),"^",6),HLOC=+$G(^DIC(42,+WLOC,44)) Q:'HLOC
|
|
..S SPNX=HLOC D SETPT
|
|
..Q
|
|
.Q
|
|
EN2 ;THIS WILL FIND ALL CURRENT PATIENTS
|
|
I SPNSEL["1" D
|
|
.S SPNX=0
|
|
.F S SPNX=$O(^TMP($J,"SPNWC",SPNX)) Q:SPNX<1 D
|
|
..S WLOC=$G(^SC(SPNX,42)) Q:+WLOC<1
|
|
..S HLOC=$P($G(^DIC(42,+WLOC,0)),U) Q:HLOC=""
|
|
..S SPNDFN=0 N SPNDT F S SPNDFN=$O(^DPT("CN",HLOC,SPNDFN)) Q:SPNDFN<1 S SPNDATE="CURRENT" D SETPT
|
|
..Q
|
|
.Q
|
|
K SPNDATE,SPNX,SPNNUM,HLOC,WLOC,SPNDFN,SPNMOV Q
|
|
SETPT ;This entry point is to set the patient data in the TMP global.
|
|
N SPNTMP
|
|
I '$D(^TMP($J,"SPNWC",SPNX)) Q
|
|
I $D(^TMP($J,"SPNWC","B",SPNDFN,SPNX)) Q
|
|
S ^TMP($J,"SPNWC",SPNX,SPNDATE,SPNDFN)=""
|
|
S ^TMP($J,"SPNWC","B",SPNDFN,SPNX)=""
|
|
S SPNTMP(1)=$P(^SC(SPNX,0),U,2)
|
|
S SPNTMP(2)=$P(^SC(SPNX,0),U)
|
|
S SPNTMP(3)=$S(SPNTMP(1)'="":SPNTMP(1),1:SPNTMP(2))
|
|
S ^TMP($J,"SPNWC","C",SPNTMP(3),SPNX)=""
|
|
Q
|