- 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
- 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