Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMXX2

PXRMXX2.m

Go to the documentation of this file.
  1. PXRMXX2 ; SLC/PJH - Build list of reminder findings;08/25/2000
  1. ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1. ;
  1. ;Called at HF, PED, LAB and POV from PXRMXX
  1. ;
  1. HF(BEGIN,END,HFS,NMSPACE) ; return patients with health factors
  1. N DATA,DFN,ERR,HF,RBEGIN,REND,TEMP K DATA,ERR
  1. I '$O(HFS(0)) Q
  1. I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
  1. I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
  1. D HFDATA(.HFS,.DATA,.ERR)
  1. S RBEGIN=9999999-BEGIN,REND=9999999-END
  1. S DFN=0 F S DFN=$O(^AUPNVHF("AA",DFN)) Q:DFN<1 D
  1. .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
  1. .I $$HFCHECK(DFN,.DATA,RBEGIN,REND) D
  1. ..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
  1. Q
  1. ;
  1. HFDATA(HFS,DATA,ERR) ;
  1. N HF,HFNAME,ZERO K ERR
  1. S HF=0 F S HF=$O(HFS(HF)) Q:HF<1 D
  1. .S ZERO=$G(^AUTTHF(HF,0)) I '$L(ZERO) Q
  1. .S HFNAME=$P(ZERO,U)
  1. .S DATA(HF)=HFNAME
  1. Q
  1. ;
  1. HFCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if health factor else 0
  1. N HF,OK,TIME
  1. S OK=0
  1. S HF=0 F S HF=$O(DATA(HF)) Q:HF<1 D
  1. .S TIME=RBEGIN F S TIME=$O(^AUPNVHF("AA",DFN,HF,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
  1. ..S OK=1
  1. Q OK
  1. ;
  1. PED(BEGIN,END,PEDS,NMSPACE) ; return patients with education
  1. N DATA,DFN,ERR,PED,RBEGIN,REND,TEMP K DATA,ERR
  1. I '$O(PEDS(0)) Q
  1. I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
  1. I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
  1. D PEDDATA(.PEDS,.DATA,.ERR)
  1. S RBEGIN=9999999-BEGIN,REND=9999999-END
  1. S DFN=0 F S DFN=$O(^AUPNVPED("AA",DFN)) Q:DFN<1 D
  1. .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
  1. .I $$PEDCHECK(DFN,.DATA,RBEGIN,REND) D
  1. ..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
  1. Q
  1. ;
  1. PEDDATA(PEDS,DATA,ERR) ;
  1. N PED,PEDNAME,ZERO K ERR
  1. S PED=0 F S PED=$O(PEDS(PED)) Q:PED<1 D
  1. .S ZERO=$G(^AUTTEDT(PED,0)) I '$L(ZERO) Q
  1. .S PEDNAME=$P(ZERO,U)
  1. .S DATA(PED)=PEDNAME
  1. Q
  1. ;
  1. PEDCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if education topic else 0
  1. N PED,OK,TIME
  1. S OK=0
  1. S PED=0 F S PED=$O(DATA(PED)) Q:PED<1 D
  1. .S TIME=RBEGIN F S TIME=$O(^AUPNVPED("AA",DFN,PED,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
  1. ..S OK=1
  1. Q OK
  1. ;
  1. EXAM(BEGIN,END,XAMS,NMSPACE) ; return patients with education
  1. N DATA,DFN,ERR,RBEGIN,REND,TEMP,XAM K DATA,ERR
  1. I '$O(XAMS(0)) Q
  1. I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
  1. I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
  1. D EXAMDATA(.XAMS,.DATA,.ERR)
  1. S RBEGIN=9999999-BEGIN,REND=9999999-END
  1. S DFN=0 F S DFN=$O(^AUPNVXAM("AA",DFN)) Q:DFN<1 D
  1. .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
  1. .I $$EXAMCHEK(DFN,.DATA,RBEGIN,REND) D
  1. ..S ^TMP(NMSPACE,$J,"TEMP",DFN)=""
  1. Q
  1. ;
  1. EXAMDATA(XAMS,DATA,ERR) ;
  1. N XAM,XAMNAME,ZERO K ERR
  1. S XAM=0 F S XAM=$O(XAMS(XAM)) Q:XAM<1 D
  1. .S ZERO=$G(^AUTTEXAM(XAM,0)) I '$L(ZERO) Q
  1. .S XAMNAME=$P(ZERO,U)
  1. .S DATA(XAM)=XAMNAME
  1. Q
  1. ;
  1. EXAMCHEK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if examination else 0
  1. N XAM,OK,TIME
  1. S OK=0
  1. S XAM=0 F S XAM=$O(DATA(XAM)) Q:XAM<1 D
  1. .S TIME=RBEGIN F S TIME=$O(^AUPNVXAM("AA",DFN,XAM,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
  1. ..S OK=1
  1. Q OK
  1. ;
  1. ;
  1. LAB(BEGIN,END,TESTS,NMSPACE) ; return patients with lab results
  1. N DATA,DFN,ERR,RBEGIN,REND,TEMP,TEST K DATA,ERR
  1. S BEGIN=+$G(BEGIN),END=+$G(END)
  1. I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
  1. I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
  1. D LABDATA(.TESTS,.DATA,.ERR)
  1. S RBEGIN=9999999-BEGIN,REND=9999999-END
  1. S DFN=0 F S DFN=$O(^DPT(DFN)) Q:DFN<1 D
  1. .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
  1. .I $$LABCHECK(DFN,.DATA,RBEGIN,REND) D
  1. ..S ^TMP(NMSPACE,$J,"TEMP",DFN)="" ;***S CNT=CNT+1
  1. Q
  1. ;
  1. LABDATA(TESTS,DATA,ERR) ;
  1. N DNODE,TEST,TESTNAME,ZERO K ERR
  1. S TEST=0 F S TEST=$O(TESTS(TEST)) Q:TEST<1 D
  1. .S ZERO=$G(^LAB(60,TEST,0))
  1. .I '$L(ZERO) Q
  1. .S DNODE=+$P($P(ZERO,U,5),";",2)
  1. .S TESTNAME=$P(ZERO,U)
  1. .I 'DNODE Q
  1. .S DATA(DNODE)=TESTNAME
  1. Q
  1. ;
  1. LABCHECK(DFN,DATA,RBEGIN,REND) ; $$ -> 1 if lab result else 0
  1. N DNODE,LRDFN,OK,TIME
  1. S OK=0
  1. S LRDFN=+$G(^DPT(DFN,"LR"))
  1. I 'LRDFN Q OK
  1. S TIME=RBEGIN F S TIME=$O(^LR(LRDFN,"CH",TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
  1. .S DNODE=0 F S DNODE=$O(DATA(DNODE)) Q:DNODE<1 D I OK Q
  1. ..I $D(^LR(LRDFN,"CH",TIME,DNODE)) D
  1. ...I '$P($G(^LR(LRDFN,"CH",TIME,0)),U,3) Q ; test must be completed
  1. ...S OK=1
  1. Q OK
  1. ;
  1. POV(BEGIN,END,INPUT,NMSPACE) ; return patients with diagnosis
  1. I INPUT=NMSPACE Q
  1. N DATA,DFN,ERR,POV,RBEGIN,REND,TEMP K DATA,ERR
  1. S BEGIN=+$G(BEGIN),END=+$G(END)
  1. I BEGIN<END S TEMP=BEGIN,BEGIN=END,END=TEMP
  1. I BEGIN=+BEGIN S BEGIN=BEGIN+.24 ; if no time, get all results on start date
  1. D POVDATA(.INPUT,.ERR)
  1. S RBEGIN=9999999-BEGIN,REND=9999999-END
  1. S DFN=0 F S DFN=$O(^AUPNVPOV("AA",DFN)) Q:DFN<1 D
  1. .I $D(^TMP(NMSPACE,$J,DFN)) Q ; skip patients already checked in same namespace
  1. .S:$$POVCHECK(DFN,INPUT,RBEGIN,REND) ^TMP(NMSPACE,$J,"TEMP",DFN)=""
  1. K ^TMP(INPUT,$J)
  1. Q
  1. ;
  1. POVDATA(INPUT,ERR) ;
  1. N NEWINPUT,POV,POVNAME,ZERO K ERR
  1. S NEWINPUT=INPUT_"ZZ"
  1. K ^TMP(NEWINPUT,$J)
  1. S POV=0 F S POV=$O(^TMP(INPUT,$J,POV)) Q:POV<1 D
  1. .;S ZERO=$G(^ICD9(POV,0)) I '$L(ZERO) Q
  1. .S ZERO=$$ICDDX^ICDCODE(POV) I '$L(ZERO) Q
  1. .S ^TMP(NEWINPUT,$J,POV)=$P(ZERO,U,2)
  1. K ^TMP(INPUT,$J)
  1. S INPUT=NEWINPUT
  1. Q
  1. ;
  1. POVCHECK(DFN,INPUT,RBEGIN,REND) ; $$ -> 1 if problem else 0
  1. N POV,OK,TIME,IEN
  1. S OK=0
  1. S TIME=RBEGIN F S TIME=$O(^AUPNVPOV("AA",DFN,TIME)) Q:TIME>REND Q:TIME<1 D I OK Q
  1. .S IEN=0 F S IEN=$O(^AUPNVPOV("AA",DFN,TIME,IEN)) Q:IEN<1 D
  1. ..S POV=+$G(^AUPNVPOV(IEN,0)) I 'POV Q
  1. ..S:$D(^TMP(INPUT,$J,POV)) OK=1
  1. Q OK