Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDL.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDL.m
r613 r623 1 PXRMINDL ; SLC/PKR - List building routines. ;07/26/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ;================================================ 4 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;General patient list term evaluator. 5 ;Return the list in ^TMP($J,PLIST) 6 N ITEM,FILENUM,PFINDPA 7 N SSFIND,TEMP,TFINDING,TFINDPA 8 S FILENUM=$$GETFNUM^PXRMDATA(ENODE) 9 I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D Q 10 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM) 11 S ITEM="" 12 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:ITEM="" D 13 . S TFINDING="" 14 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D 15 .. K PFINDPA,TFINDPA 16 .. M TFINDPA=TERMARR(20,TFINDING) 17 ..;Set the finding parameters. 18 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 19 .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST) 20 Q 21 ; 22 ;================================================ 23 FPLIST(FILENUM,SNODE,ITEM,NOCC,BDT,EDT,PLIST) ;Find patient list data for 24 ;regular files. Return the list in ^TMP($J,PLIST). 25 N DAS,DATE,DFN,DS,NFOUND 26 K ^TMP($J,PLIST) 27 I FILENUM=601.84 D SEVALPL^PXRMMH(ITEM,NOCC,BDT,EDT,PLIST) Q 28 S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001) 29 S DFN=0 30 F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D 31 . S NFOUND=0 32 . S DATE=DS 33 . F S DATE=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)!(NFOUND=NOCC) D 34 .. S NFOUND=NFOUND+1 35 .. S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE,"")) 36 .. S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_DATE 37 Q 38 ; 39 ;================================================ 40 FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,PLIST) ;Find patient list 41 ;data for a finding with a start and stop date. 42 ;Return the list in ^TMP($J,PLIST). 43 N DAS,DFN,DONE,EDTT,NFOUND,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST 44 K ^TMP($J,PLIST) 45 S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001) 46 S DFN=0 47 F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D 48 . S (DONE,NFOUND)=0 49 . S START=EDTT 50 . K TLIST 51 . F S START=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START),-1) Q:(START=0)!(DONE) D 52 .. S STOP="" 53 .. F S STOP=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP),-1) Q:(STOP="")!(DONE) D 54 ... S SDATE=$S(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP) 55 ... S OVERLAP=$$OVERLAP^PXRMINDX(START,SDATE,BDT,EDTT) 56 ... I OVERLAP="O" D 57 .... S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP,"")) 58 .... S NFOUND=NFOUND+1,TLIST(SDATE,NFOUND)=DAS_U_START_U_SDATE 59 ... I FILENUM="55NVA" Q 60 ... I FILENUM=100 Q 61 ... I OVERLAP="L" S DONE=1 Q 62 .;Return up to NGET of the most recent entries. 63 . S NFOUND=0,TDATE="" 64 . F S TDATE=$O(TLIST(TDATE)) Q:(TDATE="")!(NFOUND=NGET) D 65 .. S TIND=0 66 .. F S TIND=$O(TLIST(TDATE,TIND)) Q:(TIND="")!(NFOUND=NGET) D 67 ... S NFOUND=NFOUND+1,^TMP($J,PLIST,DFN,NFOUND)=TLIST(TDATE,TIND) 68 Q 69 ; 70 ;================================================ 71 GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list 72 ;for a regular file. Return the list in ^TMP($J,PLIST): 73 ;^TMP($J,PLIST,T/F,DFN,ITEM,COUNT,FILENUM)=DAS^DATE^VALUE 74 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST,GPLIST 75 N ICOND,IND,INVFD,IPLIST,NOCC,NFOUND,NGET 76 N SAVE,SSFIND,STATOK,STATUSA,TEMP,TGLIST,TPLIST 77 N UCIFS,USESTRT,VALUE,VSLIST 78 S TGLIST="GPLIST_PXRMINDL" 79 ;Determine if this is a finding with a start and stop date. 80 S SSFIND=$S(FILENUM=52:1,FILENUM[55:1,FILENUM=100:1,1:0) 81 S USESTRT=$S(SSFIND:$P(PFINDPA(0),U,15),1:0) 82 I FILENUM=100,USESTRT="" S USESTRT=1 83 ;Set the finding search parameters. 84 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 85 S INVFD=$P(PFINDPA(0),U,16) 86 D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA) 87 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST) 88 ;Ignore any negative occurrence counts, date reversal not allowed 89 ;in patient lists. 90 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 91 S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC) 92 I SSFIND D FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,TGLIST) 93 I 'SSFIND D FPLIST(FILENUM,SNODE,ITEM,NGET,BDT,EDT,TGLIST) 94 S DFN="" 95 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 96 . K GPLIST 97 . M GPLIST=^TMP($J,TGLIST,DFN) 98 . S (IND,NFOUND)=0 99 . K IPLIST 100 . F S IND=$O(GPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D 101 .. S TEMP=GPLIST(IND) 102 .. S DAS=$P(TEMP,U,1) 103 ..;If this a Lab finding attach the item to the DAS. 104 .. I PFINDPA(0)["LAB(60" S DAS=ITEM_"~"_DAS 105 ..;If this is a Mental Health finding attach the scale to DAS. 106 .. I PFINDPA(0)["YTT(601.71" S DAS=DAS_"S"_$P(PFINDPA(0),U,12) 107 .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD) 108 .. S VALUE=$G(FIEVD("VALUE")) 109 .. I INVFD D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0) 110 ..;If there is a status list make sure the finding has a status on 111 ..;the list. 112 .. S STATOK=$S($D(STATUSA):$$STATUSOK^PXRMINDX(.STATUSA,.FIEVD),1:1) 113 .. I 'STATOK Q 114 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1) 115 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0) 116 .. I SAVE D 117 ... S NFOUND=NFOUND+1 118 ... S IPLIST(CONVAL,DFN,ITEM,NFOUND,FILENUM)=TEMP_U_VALUE 119 . M ^TMP($J,PLIST)=IPLIST 120 K ^TMP($J,TGLIST) 121 Q 122 ; 1 PXRMINDL ; SLC/PKR - List building routines. ;07/17/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ;================================================ 4 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;General patient list term evaluator. 5 ;Return the list in ^TMP($J,PLIST) 6 N ITEM,FILENUM,PFINDPA 7 N SSFIND,TEMP,TFINDING,TFINDPA 8 S FILENUM=$$GETFNUM^PXRMDATA(ENODE) 9 I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D Q 10 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM) 11 S ITEM="" 12 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:ITEM="" D 13 . S TFINDING="" 14 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D 15 .. K PFINDPA,TFINDPA 16 .. M TFINDPA=TERMARR(20,TFINDING) 17 ..;Set the finding parameters. 18 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 19 .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST) 20 Q 21 ; 22 ;================================================ 23 FPLIST(FILENUM,SNODE,ITEM,NOCC,BDT,EDT,PLIST) ;Find patient list data for 24 ;regular files. Return the list in ^TMP($J,PLIST). 25 N DAS,DATE,DFN,DS,NFOUND 26 K ^TMP($J,PLIST) 27 I FILENUM=601.2 D SEVALPL^PXRMMH(ITEM,NOCC,BDT,EDT,PLIST) Q 28 S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001) 29 S DFN=0 30 F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D 31 . S NFOUND=0 32 . S DATE=DS 33 . F S DATE=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)!(NFOUND=NOCC) D 34 .. S NFOUND=NFOUND+1 35 .. S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE,"")) 36 .. S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_DATE 37 Q 38 ; 39 ;================================================ 40 FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,PLIST) ;Find patient list 41 ;data for a finding with a start and stop date. 42 ;Return the list in ^TMP($J,PLIST). 43 N DAS,DFN,DONE,EDTT,NFOUND,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST 44 K ^TMP($J,PLIST) 45 S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001) 46 S DFN=0 47 F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D 48 . S (DONE,NFOUND)=0 49 . S START=EDTT 50 . K TLIST 51 . F S START=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START),-1) Q:(START=0)!(DONE) D 52 .. S STOP="" 53 .. F S STOP=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP),-1) Q:(STOP="")!(DONE) D 54 ... S SDATE=$S(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP) 55 ... S OVERLAP=$$OVERLAP^PXRMINDX(START,SDATE,BDT,EDTT) 56 ... I OVERLAP="O" D 57 .... S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP,"")) 58 .... S NFOUND=NFOUND+1,TLIST(SDATE,NFOUND)=DAS_U_START_U_SDATE 59 ... I FILENUM="55NVA" Q 60 ... I FILENUM=100 Q 61 ... I OVERLAP="L" S DONE=1 Q 62 .;Return up to NGET of the most recent entries. 63 . S NFOUND=0,TDATE="" 64 . F S TDATE=$O(TLIST(TDATE)) Q:(TDATE="")!(NFOUND=NGET) D 65 .. S TIND=0 66 .. F S TIND=$O(TLIST(TDATE,TIND)) Q:(TIND="")!(NFOUND=NGET) D 67 ... S NFOUND=NFOUND+1,^TMP($J,PLIST,DFN,NFOUND)=TLIST(TDATE,TIND) 68 Q 69 ; 70 ;================================================ 71 GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list 72 ;for a regular file. Return the list in ^TMP($J,PLIST): 73 ;^TMP($J,PLIST,T/F,DFN,ITEM,COUNT,FILENUM)=DAS^DATE^VALUE 74 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST,GPLIST 75 N ICOND,IND,INVFD,IPLIST,NOCC,NFOUND,NGET 76 N SAVE,SSFIND,STATOK,STATUSA,TEMP,TGLIST,TPLIST 77 N UCIFS,USESTRT,VALUE,VSLIST 78 S TGLIST="GPLIST_PXRMINDL" 79 ;Determine if this is a finding with a start and stop date. 80 S SSFIND=$S(FILENUM=52:1,FILENUM[55:1,FILENUM=100:1,1:0) 81 S USESTRT=$S(SSFIND:$P(PFINDPA(0),U,15),1:0) 82 I FILENUM=100,USESTRT="" S USESTRT=1 83 ;Set the finding search parameters. 84 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 85 S INVFD=$P(PFINDPA(0),U,16) 86 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 87 D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA) 88 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST) 89 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC) 90 I SSFIND D FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,TGLIST) 91 I 'SSFIND D FPLIST(FILENUM,SNODE,ITEM,NGET,BDT,EDT,TGLIST) 92 S DFN="" 93 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 94 . K GPLIST 95 . M GPLIST=^TMP($J,TGLIST,DFN) 96 . S (IND,NFOUND)=0 97 . K IPLIST 98 . F S IND=$O(GPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D 99 .. S TEMP=GPLIST(IND) 100 .. S DAS=$P(TEMP,U,1) 101 ..;If this a Lab finding attach the item to the DAS. 102 .. I PFINDPA(0)["LAB(60" S DAS=ITEM_"~"_DAS 103 ..;If this is a Mental Health finding attach the scale to DAS. 104 .. I PFINDPA(0)["YTT(601" S DAS=DAS_"S"_$P(PFINDPA(0),U,12) 105 .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD) 106 .. S VALUE=$G(FIEVD("VALUE")) 107 .. I INVFD D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0) 108 ..;If there is a status list make sure the finding has a status on 109 ..;the list. 110 .. S STATOK=$S($D(STATUSA):$$STATUSOK^PXRMINDX(.STATUSA,.FIEVD),1:1) 111 .. I 'STATOK Q 112 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1) 113 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0) 114 .. I SAVE D 115 ... S NFOUND=NFOUND+1 116 ... S IPLIST(CONVAL,DFN,ITEM,NFOUND,FILENUM)=TEMP_U_VALUE 117 . M ^TMP($J,PLIST)=IPLIST 118 K ^TMP($J,TGLIST) 119 Q 120 ;
Note:
See TracChangeset
for help on using the changeset viewer.
