source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXX2.m@ 1397

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