PXRMXX2 ; SLC/PJH - Build list of reminder findings;08/25/2000
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;Called at HF, PED, LAB and POV from PXRMXX
;
HF(BEGIN,END,HFS,NMSPACE) ; return patients with health factors
N DATA,DFN,ERR,HF,RBEGIN,REND,TEMP K DATA,ERR
I '$O(HFS(0)) Q
I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
D HFDATA(.HFS,.DATA,.ERR)
S RBEGIN=9999999-BEGIN,REND=9999999-END
S DFN=0 F S DFN=$O(^AUPNVHF("AA",DFN)) Q:DFN<1 D
.I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
.I $$HFCHECK(DFN,.DATA,RBEGIN,REND) D
..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
Q
;
HFDATA(HFS,DATA,ERR) ;
N HF,HFNAME,ZERO K ERR
S HF=0 F S HF=$O(HFS(HF)) Q:HF<1 D
.S ZERO=$G(^AUTTHF(HF,0)) I '$L(ZERO) Q
.S HFNAME=$P(ZERO,U)
.S DATA(HF)=HFNAME
Q
;
HFCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if health factor else 0
N HF,OK,TIME
S OK=0
S HF=0 F S HF=$O(DATA(HF)) Q:HF<1 D
.S TIME=RBEGIN F S TIME=$O(^AUPNVHF("AA",DFN,HF,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
..S OK=1
Q OK
;
PED(BEGIN,END,PEDS,NMSPACE) ; return patients with education
N DATA,DFN,ERR,PED,RBEGIN,REND,TEMP K DATA,ERR
I '$O(PEDS(0)) Q
I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
D PEDDATA(.PEDS,.DATA,.ERR)
S RBEGIN=9999999-BEGIN,REND=9999999-END
S DFN=0 F S DFN=$O(^AUPNVPED("AA",DFN)) Q:DFN<1 D
.I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
.I $$PEDCHECK(DFN,.DATA,RBEGIN,REND) D
..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
Q
;
PEDDATA(PEDS,DATA,ERR) ;
N PED,PEDNAME,ZERO K ERR
S PED=0 F S PED=$O(PEDS(PED)) Q:PED<1 D
.S ZERO=$G(^AUTTEDT(PED,0)) I '$L(ZERO) Q
.S PEDNAME=$P(ZERO,U)
.S DATA(PED)=PEDNAME
Q
;
PEDCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if education topic else 0
N PED,OK,TIME
S OK=0
S PED=0 F S PED=$O(DATA(PED)) Q:PED<1 D
.S TIME=RBEGIN F S TIME=$O(^AUPNVPED("AA",DFN,PED,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
..S OK=1
Q OK
;
EXAM(BEGIN,END,XAMS,NMSPACE) ; return patients with education
N DATA,DFN,ERR,RBEGIN,REND,TEMP,XAM K DATA,ERR
I '$O(XAMS(0)) Q
I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
D EXAMDATA(.XAMS,.DATA,.ERR)
S RBEGIN=9999999-BEGIN,REND=9999999-END
S DFN=0 F S DFN=$O(^AUPNVXAM("AA",DFN)) Q:DFN<1 D
.I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
.I $$EXAMCHEK(DFN,.DATA,RBEGIN,REND) D
..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
Q
;
EXAMDATA(XAMS,DATA,ERR) ;
N XAM,XAMNAME,ZERO K ERR
S XAM=0 F S XAM=$O(XAMS(XAM)) Q:XAM<1 D
.S ZERO=$G(^AUTTEXAM(XAM,0)) I '$L(ZERO) Q
.S XAMNAME=$P(ZERO,U)
.S DATA(XAM)=XAMNAME
Q
;
EXAMCHEK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if examination else 0
N XAM,OK,TIME
S OK=0
S XAM=0 F S XAM=$O(DATA(XAM)) Q:XAM<1 D
.S TIME=RBEGIN F S TIME=$O(^AUPNVXAM("AA",DFN,XAM,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
..S OK=1
Q OK
;
;
LAB(BEGIN,END,TESTS,NMSPACE) ; return patients with lab results
N DATA,DFN,ERR,RBEGIN,REND,TEMP,TEST K DATA,ERR
S BEGIN=+$G(BEGIN),END=+$G(END)
I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
D LABDATA(.TESTS,.DATA,.ERR)
S RBEGIN=9999999-BEGIN,REND=9999999-END
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:DFN<1 D
.I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
.I $$LABCHECK(DFN,.DATA,RBEGIN,REND) D
..S ^TMP(NMSPACE,$J,"TEMP",DFN)="" ;***S CNT=CNT+1
Q
;
LABDATA(TESTS,DATA,ERR) ;
N DNODE,TEST,TESTNAME,ZERO K ERR
S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
.S ZERO=$G(^LAB(60,TEST,0))
.I '$L(ZERO) Q
.S DNODE=+$P($P(ZERO,U,5),";",2)
.S TESTNAME=$P(ZERO,U)
.I 'DNODE Q
.S DATA(DNODE)=TESTNAME
Q
;
LABCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if lab result else 0
N DNODE,LRDFN,OK,TIME
S OK=0
S LRDFN=+$G(^DPT(DFN,"LR"))
I 'LRDFN Q OK
S TIME=RBEGIN F S TIME=$O(^LR(LRDFN,"CH",TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
.S DNODE=0 F S DNODE=$O(DATA(DNODE)) Q:DNODE<1 D I OK Q
..I $D(^LR(LRDFN,"CH",TIME,DNODE)) D
...I '$P($G(^LR(LRDFN,"CH",TIME,0)),U,3) Q ; test must be completed
...S OK=1
Q OK
;
POV(BEGIN,END,INPUT,NMSPACE) ; return patients with diagnosis
I INPUT=NMSPACE Q
N DATA,DFN,ERR,POV,RBEGIN,REND,TEMP K DATA,ERR
S BEGIN=+$G(BEGIN),END=+$G(END)
I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
D POVDATA(.INPUT,.ERR)
S RBEGIN=9999999-BEGIN,REND=9999999-END
S DFN=0 F S DFN=$O(^AUPNVPOV("AA",DFN)) Q:DFN<1 D
.I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
.S:$$POVCHECK(DFN,INPUT,RBEGIN,REND) ^TMP(NMSPACE,$J,"TEMP",DFN)=""
K ^TMP(INPUT,$J)
Q
;
POVDATA(INPUT,ERR) ;
N NEWINPUT,POV,POVNAME,ZERO K ERR
S NEWINPUT=INPUT_"ZZ"
K ^TMP(NEWINPUT,$J)
S POV=0 F S POV=$O(^TMP(INPUT,$J,POV)) Q:POV<1 D
.;S ZERO=$G(^ICD9(POV,0)) I '$L(ZERO) Q
.S ZERO=$$ICDDX^ICDCODE(POV) I '$L(ZERO) Q
.S ^TMP(NEWINPUT,$J,POV)=$P(ZERO,U,2)
K ^TMP(INPUT,$J)
S INPUT=NEWINPUT
Q
;
POVCHECK(DFN,INPUT,RBEGIN,REND) ; $$ -> 1 if problem else 0
N POV,OK,TIME,IEN
S OK=0
S TIME=RBEGIN F S TIME=$O(^AUPNVPOV("AA",DFN,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
.S IEN=0 F S IEN=$O(^AUPNVPOV("AA",DFN,TIME,IEN)) Q:IEN<1 D
..S POV=+$G(^AUPNVPOV(IEN,0)) I 'POV Q
..S:$D(^TMP(INPUT,$J,POV)) OK=1
Q OK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXX2 5638 printed Dec 13, 2024@01:50:33 Page 2
PXRMXX2 ; SLC/PJH - Build list of reminder findings;08/25/2000
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;Called at HF, PED, LAB and POV from PXRMXX
+4 ;
HF(BEGIN,END,HFS,NMSPACE) ; return patients with health factors
+1 NEW DATA,DFN,ERR,HF,RBEGIN,REND,TEMP
KILL DATA,ERR
+2 IF '$ORDER(HFS(0))
QUIT
+3 IF BEGIN<END
SET TEMP=BEGIN
SET BEGIN=END
SET END=TEMP
+4 ; if no time, get all results on start date
IF BEGIN=+BEGIN
SET BEGIN=BEGIN+.24
+5 DO HFDATA(.HFS,.DATA,.ERR)
+6 SET RBEGIN=9999999-BEGIN
SET REND=9999999-END
+7 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNVHF("AA",DFN))
if DFN<1
QUIT
Begin DoDot:1
+8 ; skip patients already checked in same namespace
IF $DATA(^TMP(NMSPACE,$JOB,DFN))
QUIT
+9 IF $$HFCHECK(DFN,.DATA,RBEGIN,REND)
Begin DoDot:2
+10 SET ^TMP(NMSPACE,$JOB,"TEMP",DFN)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
HFDATA(HFS,DATA,ERR) ;
+1 NEW HF,HFNAME,ZERO
KILL ERR
+2 SET HF=0
FOR
SET HF=$ORDER(HFS(HF))
if HF<1
QUIT
Begin DoDot:1
+3 SET ZERO=$GET(^AUTTHF(HF,0))
IF '$LENGTH(ZERO)
QUIT
+4 SET HFNAME=$PIECE(ZERO,U)
+5 SET DATA(HF)=HFNAME
End DoDot:1
+6 QUIT
+7 ;
HFCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if health factor else 0
+1 NEW HF,OK,TIME
+2 SET OK=0
+3 SET HF=0
FOR
SET HF=$ORDER(DATA(HF))
if HF<1
QUIT
Begin DoDot:1
+4 SET TIME=RBEGIN
FOR
SET TIME=$ORDER(^AUPNVHF("AA",DFN,HF,TIME))
if TIME>REND
QUIT
if TIME<1
QUIT
Begin DoDot:2
+5 SET OK=1
End DoDot:2
IF OK
QUIT
End DoDot:1
+6 QUIT OK
+7 ;
PED(BEGIN,END,PEDS,NMSPACE) ; return patients with education
+1 NEW DATA,DFN,ERR,PED,RBEGIN,REND,TEMP
KILL DATA,ERR
+2 IF '$ORDER(PEDS(0))
QUIT
+3 IF BEGIN<END
SET TEMP=BEGIN
SET BEGIN=END
SET END=TEMP
+4 ; if no time, get all results on start date
IF BEGIN=+BEGIN
SET BEGIN=BEGIN+.24
+5 DO PEDDATA(.PEDS,.DATA,.ERR)
+6 SET RBEGIN=9999999-BEGIN
SET REND=9999999-END
+7 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNVPED("AA",DFN))
if DFN<1
QUIT
Begin DoDot:1
+8 ; skip patients already checked in same namespace
IF $DATA(^TMP(NMSPACE,$JOB,DFN))
QUIT
+9 IF $$PEDCHECK(DFN,.DATA,RBEGIN,REND)
Begin DoDot:2
+10 SET ^TMP(NMSPACE,$JOB,"TEMP",DFN)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
PEDDATA(PEDS,DATA,ERR) ;
+1 NEW PED,PEDNAME,ZERO
KILL ERR
+2 SET PED=0
FOR
SET PED=$ORDER(PEDS(PED))
if PED<1
QUIT
Begin DoDot:1
+3 SET ZERO=$GET(^AUTTEDT(PED,0))
IF '$LENGTH(ZERO)
QUIT
+4 SET PEDNAME=$PIECE(ZERO,U)
+5 SET DATA(PED)=PEDNAME
End DoDot:1
+6 QUIT
+7 ;
PEDCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if education topic else 0
+1 NEW PED,OK,TIME
+2 SET OK=0
+3 SET PED=0
FOR
SET PED=$ORDER(DATA(PED))
if PED<1
QUIT
Begin DoDot:1
+4 SET TIME=RBEGIN
FOR
SET TIME=$ORDER(^AUPNVPED("AA",DFN,PED,TIME))
if TIME>REND
QUIT
if TIME<1
QUIT
Begin DoDot:2
+5 SET OK=1
End DoDot:2
IF OK
QUIT
End DoDot:1
+6 QUIT OK
+7 ;
EXAM(BEGIN,END,XAMS,NMSPACE) ; return patients with education
+1 NEW DATA,DFN,ERR,RBEGIN,REND,TEMP,XAM
KILL DATA,ERR
+2 IF '$ORDER(XAMS(0))
QUIT
+3 IF BEGIN<END
SET TEMP=BEGIN
SET BEGIN=END
SET END=TEMP
+4 ; if no time, get all results on start date
IF BEGIN=+BEGIN
SET BEGIN=BEGIN+.24
+5 DO EXAMDATA(.XAMS,.DATA,.ERR)
+6 SET RBEGIN=9999999-BEGIN
SET REND=9999999-END
+7 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNVXAM("AA",DFN))
if DFN<1
QUIT
Begin DoDot:1
+8 ; skip patients already checked in same namespace
IF $DATA(^TMP(NMSPACE,$JOB,DFN))
QUIT
+9 IF $$EXAMCHEK(DFN,.DATA,RBEGIN,REND)
Begin DoDot:2
+10 SET ^TMP(NMSPACE,$JOB,"TEMP",DFN)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
EXAMDATA(XAMS,DATA,ERR) ;
+1 NEW XAM,XAMNAME,ZERO
KILL ERR
+2 SET XAM=0
FOR
SET XAM=$ORDER(XAMS(XAM))
if XAM<1
QUIT
Begin DoDot:1
+3 SET ZERO=$GET(^AUTTEXAM(XAM,0))
IF '$LENGTH(ZERO)
QUIT
+4 SET XAMNAME=$PIECE(ZERO,U)
+5 SET DATA(XAM)=XAMNAME
End DoDot:1
+6 QUIT
+7 ;
EXAMCHEK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if examination else 0
+1 NEW XAM,OK,TIME
+2 SET OK=0
+3 SET XAM=0
FOR
SET XAM=$ORDER(DATA(XAM))
if XAM<1
QUIT
Begin DoDot:1
+4 SET TIME=RBEGIN
FOR
SET TIME=$ORDER(^AUPNVXAM("AA",DFN,XAM,TIME))
if TIME>REND
QUIT
if TIME<1
QUIT
Begin DoDot:2
+5 SET OK=1
End DoDot:2
IF OK
QUIT
End DoDot:1
+6 QUIT OK
+7 ;
+8 ;
LAB(BEGIN,END,TESTS,NMSPACE) ; return patients with lab results
+1 NEW DATA,DFN,ERR,RBEGIN,REND,TEMP,TEST
KILL DATA,ERR
+2 SET BEGIN=+$GET(BEGIN)
SET END=+$GET(END)
+3 IF BEGIN<END
SET TEMP=BEGIN
SET BEGIN=END
SET END=TEMP
+4 ; if no time, get all results on start date
IF BEGIN=+BEGIN
SET BEGIN=BEGIN+.24
+5 DO LABDATA(.TESTS,.DATA,.ERR)
+6 SET RBEGIN=9999999-BEGIN
SET REND=9999999-END
+7 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
if DFN<1
QUIT
Begin DoDot:1
+8 ; skip patients already checked in same namespace
IF $DATA(^TMP(NMSPACE,$JOB,DFN))
QUIT
+9 IF $$LABCHECK(DFN,.DATA,RBEGIN,REND)
Begin DoDot:2
+10 ;***S CNT=CNT+1
SET ^TMP(NMSPACE,$JOB,"TEMP",DFN)=""
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
LABDATA(TESTS,DATA,ERR) ;
+1 NEW DNODE,TEST,TESTNAME,ZERO
KILL ERR
+2 SET TEST=0
FOR
SET TEST=$ORDER(TESTS(TEST))
if TEST<1
QUIT
Begin DoDot:1
+3 SET ZERO=$GET(^LAB(60,TEST,0))
+4 IF '$LENGTH(ZERO)
QUIT
+5 SET DNODE=+$PIECE($PIECE(ZERO,U,5),";",2)
+6 SET TESTNAME=$PIECE(ZERO,U)
+7 IF 'DNODE
QUIT
+8 SET DATA(DNODE)=TESTNAME
End DoDot:1
+9 QUIT
+10 ;
LABCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if lab result else 0
+1 NEW DNODE,LRDFN,OK,TIME
+2 SET OK=0
+3 SET LRDFN=+$GET(^DPT(DFN,"LR"))
+4 IF 'LRDFN
QUIT OK
+5 SET TIME=RBEGIN
FOR
SET TIME=$ORDER(^LR(LRDFN,"CH",TIME))
if TIME>REND
QUIT
if TIME<1
QUIT
Begin DoDot:1
+6 SET DNODE=0
FOR
SET DNODE=$ORDER(DATA(DNODE))
if DNODE<1
QUIT
Begin DoDot:2
+7 IF $DATA(^LR(LRDFN,"CH",TIME,DNODE))
Begin DoDot:3
+8 ; test must be completed
IF '$PIECE($GET(^LR(LRDFN,"CH",TIME,0)),U,3)
QUIT
+9 SET OK=1
End DoDot:3
End DoDot:2
IF OK
QUIT
End DoDot:1
IF OK
QUIT
+10 QUIT OK
+11 ;
POV(BEGIN,END,INPUT,NMSPACE) ; return patients with diagnosis
+1 IF INPUT=NMSPACE
QUIT
+2 NEW DATA,DFN,ERR,POV,RBEGIN,REND,TEMP
KILL DATA,ERR
+3 SET BEGIN=+$GET(BEGIN)
SET END=+$GET(END)
+4 IF BEGIN<END
SET TEMP=BEGIN
SET BEGIN=END
SET END=TEMP
+5 ; if no time, get all results on start date
IF BEGIN=+BEGIN
SET BEGIN=BEGIN+.24
+6 DO POVDATA(.INPUT,.ERR)
+7 SET RBEGIN=9999999-BEGIN
SET REND=9999999-END
+8 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNVPOV("AA",DFN))
if DFN<1
QUIT
Begin DoDot:1
+9 ; skip patients already checked in same namespace
IF $DATA(^TMP(NMSPACE,$JOB,DFN))
QUIT
+10 if $$POVCHECK(DFN,INPUT,RBEGIN,REND)
SET ^TMP(NMSPACE,$JOB,"TEMP",DFN)=""
End DoDot:1
+11 KILL ^TMP(INPUT,$JOB)
+12 QUIT
+13 ;
POVDATA(INPUT,ERR) ;
+1 NEW NEWINPUT,POV,POVNAME,ZERO
KILL ERR
+2 SET NEWINPUT=INPUT_"ZZ"
+3 KILL ^TMP(NEWINPUT,$JOB)
+4 SET POV=0
FOR
SET POV=$ORDER(^TMP(INPUT,$JOB,POV))
if POV<1
QUIT
Begin DoDot:1
+5 ;S ZERO=$G(^ICD9(POV,0)) I '$L(ZERO) Q
+6 SET ZERO=$$ICDDX^ICDCODE(POV)
IF '$LENGTH(ZERO)
QUIT
+7 SET ^TMP(NEWINPUT,$JOB,POV)=$PIECE(ZERO,U,2)
End DoDot:1
+8 KILL ^TMP(INPUT,$JOB)
+9 SET INPUT=NEWINPUT
+10 QUIT
+11 ;
POVCHECK(DFN,INPUT,RBEGIN,REND) ; $$ -> 1 if problem else 0
+1 NEW POV,OK,TIME,IEN
+2 SET OK=0
+3 SET TIME=RBEGIN
FOR
SET TIME=$ORDER(^AUPNVPOV("AA",DFN,TIME))
if TIME>REND
QUIT
if TIME<1
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVPOV("AA",DFN,TIME,IEN))
if IEN<1
QUIT
Begin DoDot:2
+5 SET POV=+$GET(^AUPNVPOV(IEN,0))
IF 'POV
QUIT
+6 if $DATA(^TMP(INPUT,$JOB,POV))
SET OK=1
End DoDot:2
End DoDot:1
IF OK
QUIT
+7 QUIT OK
