BPXRMAS1 ; IHS/MSC/MGH - Handle Asthma findings. ;24-May-2013 15:04;DU
;;2.0;CLINICAL REMINDERS;**1001**;Feb 04 2005;Build 21
;
;Entries in the PCC asthma types can be used in findings for the EHR reminder terms
;=======================================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate refusal findings.
N ITEM,INVDATE,REFTYP,FINDING,FIEVT
S ITEM=""
F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:ITEM="" D
. S FINDING=""
. F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
..M FINDPA=DEFARR(20,FINDING)
..K FIEVT
..D FIEVAL(DFN,ITEM,FINDING,.FINDPA,.FIEVT)
..M FIEVAL(FINDING)=FIEVT
..S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
Q
;
;=======================================================================
EVALTERM(DFN,FINDING,TERMIEN,TFIEVAL) ;Evaluate refusal terms.
N REFIEN,FIND0,FIND3,INVDATE,LFIEVAL,TFIND0,TFIND3,TFINDING
F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
.. K FIEVT,PFINDPA,TFINDPA
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
.. D FIEVAL(DFN,ITEM,.PFINDPA,.FIEVT)
.. M TFIEVAL(TFINDING)=FIEVT
.. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
Q
;
;=======================================================================
FIEVAL(DFN,ITEM,FINDING,PFINDPA,FIEVAL) ;
N DATE,IEN,IND,USESTRT,RSLT,TEMP,VALID,VIEN,FIEN,FINISHED,ASTYPE
;Set finding to zero to start
;Set the finding search parameters.
N NFOUND,NGET,NOCC,NP,SDIR,SAVE,SSFIND,CASESEN,UCIFS,VSLIST
N NP,DAS,IND
D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
S SDIR=$S(NOCC<0:+1,1:-1)
S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
S NGET=NOCC
S SSFIND=0,USESTRT=0
S ASTYP=$P($G(DEFARR(20,FINDING,0)),";",1)
D FPDAT(DFN,ASTYP,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
I NFOUND=0 S FIEVAL=0 Q
S NP=0
S SAVE=0
F IND=1:1:NFOUND Q:NP=NOCC D
. S DAS=$P(FLIST(IND),U,1)
. ;get the data on the findings
. D GETDATA(DAS,.FIEVD)
. S NP=NP+1
. S FIEVAL(NP)=1
. S FIEVAL(NP,"DAS")=$P(FLIST(IND),U,1)
. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
. M FIEVAL(NP)=FIEVD
. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVD
;Save the finding result.
D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
S FIEVAL("FILE NUMBER")=9000010.41
Q
;=======================================================================
FPDAT(DFN,ASTYP,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;Find pt data
N DAS,DATE,DONE,EDTT,FIEN,INVDATE,FOUND,IEN,VIEN,DATE,RSLT,TEMP,CONTROL,INV
S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
S (FINISHED,NFOUND)=0
;S DATE=$S(SDIR=+1:BDT-.000001,1:EDTT)
S FOUND=0
S INV=999999-BDT
S CONTROL=$P($G(^APCDACV(ASTYP,0)),U,2)
S INVDATE="" F S INVDATE=$O(^AUPNVAST("AA",DFN,INVDATE)) Q:'+INVDATE!(FOUND=1) D
.S FIEN="" F S FIEN=$O(^AUPNVAST("AA",DFN,INVDATE,FIEN)) Q:'+FIEN!(FOUND=1) D
..S TEMP=$G(^AUPNVAST(FIEN,0))
..S RSLT=$P(TEMP,U,14)
..S VIEN=$P(TEMP,U,3)
..Q:RSLT=""
..Q:RSLT'=CONTROL
..S DATE=$P($G(^AUPNVAST(FIEN,12)),U,1) ;Get date entered
..I DATE="" S DATE=$$VDATE^PXRMDATE(VIEN) ;else get visit date
..Q:DATE<BDT
..Q:DATE>EDTT
..S NFOUND=NFOUND+1
..S FOUND=1
..S FLIST(NFOUND)=FIEN_U_DATE
Q
;===========================================================
GETDATA(DAS,FIEVD) ;Get the asthma data
N TEMP,VIEN,DATE,RES1,RES2
S TEMP=$G(^AUPNVAST(DAS,0))
S VIEN=$P(TEMP,U,3)
S DATE=$P($G(^AUPNVAST(DAS,12)),U,1) ;Get date entered
I DATE="" S DATE=$$VDATE^PXRMDATE(VIEN)
S RES1=$P(TEMP,U,14)
S RES2=$S(RES1="W":"WELL CONTROLLED",RES1="N":"NOT WELL CONTROLLED",RES1="V":"VERY POORLY CONTROLLED",1:"")
S FIEVD("RESULT")=RES2
S FIEVD("DATE")=DATE
S FIEVD("VISIT")=$P(TEMP,U,3)
Q
;============================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output
N EM,FIEN,IND,JND,NAME,NOUT,PNAME,RESULT,TEMP,TEXTOUT,VDATE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S TEMP=$G(^AUPNVAST(FIEN,0))
S PNAME=$P(TEMP,U,1)
S PNAME=$P(^APCDACV(PNAME,0),U,1)
S NAME=$$INSCHR^PXRMEXLC(INDENT," ")_"Asthma Control: "_PNAME_" = "
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S VDATE=IFIEVAL(IND,"DATE")
. S RESULT=$G(IFIEVAL(IND,"RESULT"))
. S TEMP=RESULT_"("_$$EDATE^PXRMDATE(VDATE)_")"
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;============================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
N REFIEN,EM,FIEN,IND,PNAME,RSLT,TEMP,VDATE
S FIEN=$P(IFIEVAL("FINDING"),";",1)
S NLINES=NLINES+1
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Asthma Control: "
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S VDATE=IFIEVAL(IND,"DATE")
. S RESULT=$G(IFIEVAL(IND,"RESULT"))
. S TEMP=RESULT_" "_$$EDATE^PXRMDATE(VDATE)
. D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;=======================================================================
BPXRMAS1 ; IHS/MSC/MGH - Handle Asthma findings. ;24-May-2013 15:04;DU
+1 ;;2.0;CLINICAL REMINDERS;**1001**;Feb 04 2005;Build 21
+2 ;
+3 ;Entries in the PCC asthma types can be used in findings for the EHR reminder terms
+4 ;=======================================================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate refusal findings.
+1 NEW ITEM,INVDATE,REFTYP,FINDING,FIEVT
+2 SET ITEM=""
+3 FOR
SET ITEM=$ORDER(DEFARR("E",ENODE,ITEM))
IF ITEM=""
QUIT
Begin DoDot:1
+4 SET FINDING=""
+5 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,ITEM,FINDING))
IF +FINDING=0
QUIT
Begin DoDot:2
+6 MERGE FINDPA=DEFARR(20,FINDING)
+7 KILL FIEVT
+8 DO FIEVAL(DFN,ITEM,FINDING,.FINDPA,.FIEVT)
+9 MERGE FIEVAL(FINDING)=FIEVT
+10 SET FIEVAL(FINDING,"FINDING")=$PIECE(FINDPA(0),U,1)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
+13 ;=======================================================================
EVALTERM(DFN,FINDING,TERMIEN,TFIEVAL) ;Evaluate refusal terms.
+1 NEW REFIEN,FIND0,FIND3,INVDATE,LFIEVAL,TFIND0,TFIND3,TFINDING
+2 FOR
SET ITEM=$ORDER(TERMARR("E",ENODE,ITEM))
IF +ITEM=0
QUIT
Begin DoDot:1
+3 SET TFINDING=""
+4 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,ITEM,TFINDING))
IF +TFINDING=0
QUIT
Begin DoDot:2
+5 KILL FIEVT,PFINDPA,TFINDPA
+6 MERGE TFINDPA=TERMARR(20,TFINDING)
+7 ;Set the finding parameters.
+8 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+9 DO FIEVAL(DFN,ITEM,.PFINDPA,.FIEVT)
+10 MERGE TFIEVAL(TFINDING)=FIEVT
+11 SET TFIEVAL(TFINDING,"FINDING")=$PIECE(TFINDPA(0),U,1)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;=======================================================================
FIEVAL(DFN,ITEM,FINDING,PFINDPA,FIEVAL) ;
+1 NEW DATE,IEN,IND,USESTRT,RSLT,TEMP,VALID,VIEN,FIEN,FINISHED,ASTYPE
+2 ;Set finding to zero to start
+3 ;Set the finding search parameters.
+4 NEW NFOUND,NGET,NOCC,NP,SDIR,SAVE,SSFIND,CASESEN,UCIFS,VSLIST
+5 NEW NP,DAS,IND
+6 DO SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
+7 SET SDIR=$SELECT(NOCC<0:+1,1:-1)
+8 SET NOCC=$SELECT(NOCC<0:-NOCC,1:NOCC)
+9 SET NGET=NOCC
+10 SET SSFIND=0
SET USESTRT=0
+11 SET ASTYP=$PIECE($GET(DEFARR(20,FINDING,0)),";",1)
+12 DO FPDAT(DFN,ASTYP,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
+13 IF NFOUND=0
SET FIEVAL=0
QUIT
+14 SET NP=0
+15 SET SAVE=0
+16 FOR IND=1:1:NFOUND
IF NP=NOCC
QUIT
Begin DoDot:1
+17 SET DAS=$PIECE(FLIST(IND),U,1)
+18 ;get the data on the findings
+19 DO GETDATA(DAS,.FIEVD)
+20 SET NP=NP+1
+21 SET FIEVAL(NP)=1
+22 SET FIEVAL(NP,"DAS")=$PIECE(FLIST(IND),U,1)
+23 SET FIEVAL(NP,"DATE")=$PIECE(FLIST(IND),U,2)
+24 MERGE FIEVAL(NP)=FIEVD
+25 IF $GET(PXRMDEBG)
MERGE FIEVAL(NP,"CSUB")=FIEVD
End DoDot:1
+26 ;Save the finding result.
+27 DO SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
+28 SET FIEVAL("FILE NUMBER")=9000010.41
+29 QUIT
+30 ;=======================================================================
FPDAT(DFN,ASTYP,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;Find pt data
+1 NEW DAS,DATE,DONE,EDTT,FIEN,INVDATE,FOUND,IEN,VIEN,DATE,RSLT,TEMP,CONTROL,INV
+2 SET EDTT=$SELECT(EDT[".":EDT+.0000001,1:EDT+.240001)
+3 SET (FINISHED,NFOUND)=0
+4 ;S DATE=$S(SDIR=+1:BDT-.000001,1:EDTT)
+5 SET FOUND=0
+6 SET INV=999999-BDT
+7 SET CONTROL=$PIECE($GET(^APCDACV(ASTYP,0)),U,2)
+8 SET INVDATE=""
FOR
SET INVDATE=$ORDER(^AUPNVAST("AA",DFN,INVDATE))
IF '+INVDATE!(FOUND=1)
QUIT
Begin DoDot:1
+9 SET FIEN=""
FOR
SET FIEN=$ORDER(^AUPNVAST("AA",DFN,INVDATE,FIEN))
IF '+FIEN!(FOUND=1)
QUIT
Begin DoDot:2
+10 SET TEMP=$GET(^AUPNVAST(FIEN,0))
+11 SET RSLT=$PIECE(TEMP,U,14)
+12 SET VIEN=$PIECE(TEMP,U,3)
+13 IF RSLT=""
QUIT
+14 IF RSLT'=CONTROL
QUIT
+15 ;Get date entered
SET DATE=$PIECE($GET(^AUPNVAST(FIEN,12)),U,1)
+16 ;else get visit date
IF DATE=""
SET DATE=$$VDATE^PXRMDATE(VIEN)
+17 IF DATE<BDT
QUIT
+18 IF DATE>EDTT
QUIT
+19 SET NFOUND=NFOUND+1
+20 SET FOUND=1
+21 SET FLIST(NFOUND)=FIEN_U_DATE
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;===========================================================
GETDATA(DAS,FIEVD) ;Get the asthma data
+1 NEW TEMP,VIEN,DATE,RES1,RES2
+2 SET TEMP=$GET(^AUPNVAST(DAS,0))
+3 SET VIEN=$PIECE(TEMP,U,3)
+4 ;Get date entered
SET DATE=$PIECE($GET(^AUPNVAST(DAS,12)),U,1)
+5 IF DATE=""
SET DATE=$$VDATE^PXRMDATE(VIEN)
+6 SET RES1=$PIECE(TEMP,U,14)
+7 SET RES2=$SELECT(RES1="W":"WELL CONTROLLED",RES1="N":"NOT WELL CONTROLLED",RES1="V":"VERY POORLY CONTROLLED",1:"")
+8 SET FIEVD("RESULT")=RES2
+9 SET FIEVD("DATE")=DATE
+10 SET FIEVD("VISIT")=$PIECE(TEMP,U,3)
+11 QUIT
+12 ;============================================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output
+1 NEW EM,FIEN,IND,JND,NAME,NOUT,PNAME,RESULT,TEMP,TEXTOUT,VDATE
+2 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+3 SET TEMP=$GET(^AUPNVAST(FIEN,0))
+4 SET PNAME=$PIECE(TEMP,U,1)
+5 SET PNAME=$PIECE(^APCDACV(PNAME,0),U,1)
+6 SET NAME=$$INSCHR^PXRMEXLC(INDENT," ")_"Asthma Control: "_PNAME_" = "
+7 SET IND=0
+8 FOR
SET IND=+$ORDER(IFIEVAL(IND))
IF IND=0
QUIT
Begin DoDot:1
+9 SET VDATE=IFIEVAL(IND,"DATE")
+10 SET RESULT=$GET(IFIEVAL(IND,"RESULT"))
+11 SET TEMP=RESULT_"("_$$EDATE^PXRMDATE(VDATE)_")"
+12 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+13 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+14 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+15 QUIT
+16 ;============================================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW REFIEN,EM,FIEN,IND,PNAME,RSLT,TEMP,VDATE
+3 SET FIEN=$PIECE(IFIEVAL("FINDING"),";",1)
+4 SET NLINES=NLINES+1
+5 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Asthma Control: "
+6 SET IND=0
+7 FOR
SET IND=+$ORDER(IFIEVAL(IND))
IF IND=0
QUIT
Begin DoDot:1
+8 SET VDATE=IFIEVAL(IND,"DATE")
+9 SET RESULT=$GET(IFIEVAL(IND,"RESULT"))
+10 SET TEMP=RESULT_" "_$$EDATE^PXRMDATE(VDATE)
+11 DO FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
+12 FOR JND=1:1:NOUT
SET NLINES=NLINES+1
SET TEXT(NLINES)=TEXTOUT(JND)
End DoDot:1
+13 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+14 QUIT
+15 ;=======================================================================
