Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDRGR.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/PXRMDRGR.m
r613 r623 1 PXRMDRGR ; SLC/PKR - Handle groups of drug findings. ;06/20/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ;Groups are drug classes or VA Generic. 4 ;================================================== 5 EVALFI(DFN,DEFARR,ENODE,XREF,FIEVAL) ;Evaluate drug group findings. 6 N DRGRIEN,FIEVT,FINDPA,FINDING,NOINDEX 7 S NOINDEX=0 8 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 9 . D NOINDEX^PXRMERRH("D",PXRMITEM,52) 10 . S NOINDEX=1 11 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 12 . D NOINDEX^PXRMERRH("D",PXRMITEM,55) 13 . S NOINDEX=1 14 S DRGRIEN="" 15 F S DRGRIEN=$O(DEFARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0 D 16 . S FINDING="" 17 . F S FINDING=$O(DEFARR("E",ENODE,DRGRIEN,FINDING)) Q:+FINDING=0 D 18 .. I NOINDEX S FIEVAL(FINDING)=0 Q 19 .. K FIEVT,FINDPA 20 .. M FINDPA=DEFARR(20,FINDING) 21 .. D FIEVAL(DFN,DRGRIEN,.FINDPA,.DEFARR,FINDING,XREF,.FIEVT) 22 .. M FIEVAL(FINDING)=FIEVT 23 .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1) 24 Q 25 ; 26 ;================================================== 27 EVALPL(FINDPA,ENODE,XREF,TERMARR,PLIST) ;Evaluate drug group 28 ;terms for building patient lists. 29 N DRGRIEN,NOINDEX,PFINDPA 30 N TEMP,TFINDPA,TFINDING 31 S NOINDEX=0 32 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 33 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 34 . S NOINDEX=1 35 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 36 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 37 . S NOINDEX=1 38 I NOINDEX Q 39 S DRGRIEN="" 40 F S DRGRIEN=$O(TERMARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0 D 41 . S TFINDING="" 42 . F S TFINDING=$O(TERMARR("E",ENODE,DRGRIEN,TFINDING)) Q:+TFINDING=0 D 43 .. K PFINDPA,TFINDPA 44 .. M TFINDPA=TERMARR(20,TFINDING) 45 ..;Set the finding parameters. 46 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 47 .. D GPLIST(DRGRIEN,.PFINDPA,XREF,.PLIST) 48 Q 49 ; 50 ;================================================== 51 EVALTERM(DFN,FINDPA,ENODE,XREF,TERMARR,TFIEVAL) ;Evaluate drug 52 ;group terms. 53 N DRGRIEN,FIEVT,NOINDEX,PFINDPA 54 N TEMP,TFINDPA,TFINDING 55 S NOINDEX=0 56 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 57 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 58 . S NOINDEX=1 59 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 60 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 61 . S NOINDEX=1 62 S DRGRIEN="" 63 F S DRGRIEN=$O(TERMARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0 D 64 . S TFINDING="" 65 . F S TFINDING=$O(TERMARR("E",ENODE,DRGRIEN,TFINDING)) Q:+TFINDING=0 D 66 .. I NOINDEX S TFIEVAL(TFINDING)=0 Q 67 .. K FIEVT,PFINDPA,TFINDPA 68 .. M TFINDPA=TERMARR(20,TFINDING) 69 ..;Set the finding parameters. 70 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 71 .. D FIEVAL(DFN,DRGRIEN,.PFINDPA,.TERMARR,TFINDING,XREF,.FIEVT) 72 .. M TFIEVAL(TFINDING)=FIEVT 73 .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1) 74 Q 75 ; 76 ;================================================== 77 FIEVAL(DFN,DRGRIEN,FINDPA,DEFARR,FINDING,XREF,FIEVAL) ; 78 N DATE,DATEORDR,DRBEG,DREND,DRUG,DRUGIEN,IND,FIEVT,FIEVTL 79 N NOCC,NFOUND,POI,POIBEG,POIEND,POIIEN,RXTYL 80 N SDIR,TDATE,TIND 81 S NOCC=$P(FINDPA(0),U,14) 82 I NOCC="" S NOCC=1 83 S SDIR=$S(NOCC<0:+1,1:-1) 84 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 85 ;Determine where we search. 86 D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL) 87 D GETPDR(DFN,.RXTYL,.DRBEG,.DREND,.POIBEG,.POIEND) 88 I DREND=0,POIEND=0 S FIEVAL=0 Q 89 S (DRUGIEN,NFOUND)=0 90 F S DRUGIEN=+$O(^PSDRUG(XREF,DRGRIEN,DRUGIEN)) Q:DRUGIEN=0 D 91 . I DRUGIEN'<DRBEG,DRUGIEN'>DREND S DRUG=DRUGIEN 92 . E S DRUG=0 93 .;DBIA #221 94 . S POIIEN=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 95 . I POIIEN'<POIBEG,POIIEN'>POIEND S POI=POIIEN 96 . E S POI=0 97 . K FIEVT 98 . D DEVAL^PXRMDRUG(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUG,POI,.FIEVT) 99 . I FIEVT D 100 .. S IND=0 101 .. F S IND=+$O(FIEVT(IND)) Q:IND=0 D 102 ...;Make sure this is not already on the list 103 ... I $$ONLIST(.FIEVTL,IND,.FIEVT) Q 104 ... S NFOUND=NFOUND+1,FIEVTL(NFOUND,"DISPENSE DRUG")=DRUGIEN 105 ... M FIEVTL(NFOUND)=FIEVT(IND) 106 ... S DATEORDR(FIEVT(IND,"DATE"),NFOUND)=FIEVT(IND,"FINDING") 107 ...;Don't keep more than NOCC occurrences on the list. 108 ... I NFOUND>NOCC D 109 .... S TDATE=$O(DATEORDR(""),-SDIR),TIND=$O(DATEORDR(TDATE,"")) 110 .... K FIEVTL(TIND),DATEORDR(TDATE,TIND) 111 I NFOUND=0 S FIEVAL=0 Q 112 ;Order by date. 113 S DATE="",NFOUND=0 114 F S DATE=$O(DATEORDR(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC) D 115 . S IND=0 116 . F S IND=$O(DATEORDR(DATE,IND)) Q:(IND="")!(NFOUND=NOCC) D 117 .. S NFOUND=NFOUND+1 118 .. M FIEVAL(NFOUND)=FIEVTL(IND) 119 ;Save the finding result. 120 D SFRES^PXRMUTIL(SDIR,NFOUND,.FIEVAL) 121 Q 122 ; 123 ;================================================== 124 GETPDR(DFN,RXTYL,DRBEG,DREND,POIBEG,POIEND) ;Return the beginning drug and 125 ;ending drug for a patient. 126 N IBEG,IEND,OBEG,OEND 127 I $D(RXTYL("I")) D 128 . S IBEG=+$O(^PXRMINDX(55,"PI",DFN,0)) 129 . S IEND=+$O(^PXRMINDX(55,"PI",DFN,""),-1) 130 E S (IBEG,IEND)=0 131 I $D(RXTYL("O")) D 132 . S OBEG=+$O(^PXRMINDX(52,"PI",DFN,0)) 133 . S OEND=+$O(^PXRMINDX(52,"PI",DFN,""),-1) 134 E S (OBEG,OEND)=0 135 S DRBEG=$S(IBEG<OBEG:IBEG,1:OBEG) 136 S DREND=$S(IEND>OEND:IEND,1:OEND) 137 I $D(RXTYL("N")) D 138 . S POIBEG=+$O(^PXRMINDX("55NVA","PI",DFN,0)) 139 . S POIEND=+$O(^PXRMINDX("55NVA","PI",DFN,""),-1) 140 E S (POIBEG,POIEND)=0 141 Q 142 ; 143 ;================================================== 144 GPLIST(DRGRIEN,PFINDPA,XREF,PLIST) ; 145 N DATE,DFN,DRUGIEN,FILENUM,IND,ITEM,NFOUND,NOCC,POI,RXTYL 146 N TF,TEMP,TGLIST,TLIST 147 S TGLIST="GPLIST_PXRMDRGR" 148 K ^TMP($J,TGLIST) 149 ;Determine where we search. 150 D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL) 151 S DRUGIEN=0 152 F S DRUGIEN=$O(^PSDRUG(XREF,DRGRIEN,DRUGIEN)) Q:+DRUGIEN=0 D 153 . ;DBIA #221 154 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 155 . I $D(RXTYL("I")) D GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST) 156 . I $D(RXTYL("N")),POI'="" D GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST) 157 . I $D(RXTYL("O")) D GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST) 158 ;Return the NOCC most recent results for each DFN. 159 S NOCC=$P(FINDPA(0),U,14) 160 S NOCC=$S(NOCC<0:-NOCC,NOCC="":1,1:NOCC) 161 F TF=0,1 D 162 . S DFN=0 163 . F S DFN=$O(^TMP($J,TGLIST,TF,DFN)) Q:DFN="" D 164 .. K TLIST 165 .. S ITEM="" 166 .. F S ITEM=$O(^TMP($J,TGLIST,TF,DFN,ITEM)) Q:ITEM="" D 167 ... S NFOUND="" 168 ... F S NFOUND=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND)) Q:NFOUND="" D 169 .... S FILENUM="" 170 .... F S FILENUM=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)) Q:FILENUM="" D 171 ..... S TEMP=^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM) 172 ..... S DATE=+$P(TEMP,U,3) 173 ..... S TLIST(TF,DATE,ITEM,NFOUND,FILENUM)="" 174 .. S DATE="",NFOUND=0 175 .. F S DATE=$O(TLIST(TF,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D 176 ... S ITEM="" 177 ... F S ITEM=$O(TLIST(TF,DATE,ITEM)) Q:(ITEM="")!(NFOUND=NOCC) D 178 .... S IND="" 179 .... F S IND=$O(TLIST(TF,DATE,ITEM,IND)) Q:(IND="")!(NFOUND=NOCC) D 180 ..... S FILENUM="" 181 ..... F S FILENUM=$O(TLIST(TF,DATE,ITEM,IND,FILENUM)) Q:(FILENUM="")!(NFOUND=NOCC) D 182 ...... S NFOUND=NFOUND+1 183 ...... S ^TMP($J,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($J,TGLIST,TF,DFN,ITEM,IND,FILENUM) 184 K ^TMP($J,TGLIST) 185 Q 186 ; 187 ;================================================== 188 ONLIST(FIEVTL,IND,FIEVT) ;Return true if FIEVT(IND) is already on 189 ;FIEVTL. 190 N JND,ONLIST 191 S (JND,ONLIST)=0 192 F S JND=$O(FIEVTL(JND)) Q:(ONLIST)!(JND="") D 193 . I FIEVTL(JND,"FILE NUMBER")'=FIEVT(IND,"FILE NUMBER") Q 194 . I FIEVTL(JND,"DAS")'=FIEVT(IND,"DAS") Q 195 . S ONLIST=1 196 Q ONLIST 197 ; 1 PXRMDRGR ; SLC/PKR - Handle groups of drug findings. ;06/12/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ;Groups are drug classes or VA Generic. 4 ;================================================== 5 EVALFI(DFN,DEFARR,ENODE,XREF,FIEVAL) ;Evaluate drug group findings. 6 N DRGRIEN,FIEVT,FINDPA,FINDING,NOINDEX 7 S NOINDEX=0 8 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 9 . D NOINDEX^PXRMERRH("D",PXRMITEM,52) 10 . S NOINDEX=1 11 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 12 . D NOINDEX^PXRMERRH("D",PXRMITEM,55) 13 . S NOINDEX=1 14 S DRGRIEN="" 15 F S DRGRIEN=$O(DEFARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0 D 16 . S FINDING="" 17 . F S FINDING=$O(DEFARR("E",ENODE,DRGRIEN,FINDING)) Q:+FINDING=0 D 18 .. I NOINDEX S FIEVAL(FINDING)=0 Q 19 .. K FIEVT,FINDPA 20 .. M FINDPA=DEFARR(20,FINDING) 21 .. D FIEVAL(DFN,DRGRIEN,.FINDPA,.DEFARR,FINDING,XREF,.FIEVT) 22 .. M FIEVAL(FINDING)=FIEVT 23 .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1) 24 Q 25 ; 26 ;================================================== 27 EVALPL(FINDPA,ENODE,XREF,TERMARR,PLIST) ;Evaluate drug group 28 ;terms for building patient lists. 29 N DRGRIEN,NOINDEX,PFINDPA 30 N TEMP,TFINDPA,TFINDING 31 S NOINDEX=0 32 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 33 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 34 . S NOINDEX=1 35 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 36 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 37 . S NOINDEX=1 38 I NOINDEX Q 39 S DRGRIEN="" 40 F S DRGRIEN=$O(TERMARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0 D 41 . S TFINDING="" 42 . F S TFINDING=$O(TERMARR("E",ENODE,DRGRIEN,TFINDING)) Q:+TFINDING=0 D 43 .. K PFINDPA,TFINDPA 44 .. M TFINDPA=TERMARR(20,TFINDING) 45 ..;Set the finding parameters. 46 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 47 .. D GPLIST(DRGRIEN,.PFINDPA,XREF,.PLIST) 48 Q 49 ; 50 ;================================================== 51 EVALTERM(DFN,FINDPA,ENODE,XREF,TERMARR,TFIEVAL) ;Evaluate drug 52 ;group terms. 53 N DRGRIEN,FIEVT,NOINDEX,PFINDPA 54 N TEMP,TFINDPA,TFINDING 55 S NOINDEX=0 56 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 57 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 58 . S NOINDEX=1 59 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 60 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 61 . S NOINDEX=1 62 S DRGRIEN="" 63 F S DRGRIEN=$O(TERMARR("E",ENODE,DRGRIEN)) Q:+DRGRIEN=0 D 64 . S TFINDING="" 65 . F S TFINDING=$O(TERMARR("E",ENODE,DRGRIEN,TFINDING)) Q:+TFINDING=0 D 66 .. I NOINDEX S TFIEVAL(TFINDING)=0 Q 67 .. K FIEVT,PFINDPA,TFINDPA 68 .. M TFINDPA=TERMARR(20,TFINDING) 69 ..;Set the finding parameters. 70 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 71 .. D FIEVAL(DFN,DRGRIEN,.PFINDPA,.TERMARR,TFINDING,XREF,.FIEVT) 72 .. M TFIEVAL(TFINDING)=FIEVT 73 .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1) 74 Q 75 ; 76 ;================================================== 77 FIEVAL(DFN,DRGRIEN,FINDPA,DEFARR,FINDING,XREF,FIEVAL) ; 78 N DATE,DATEORDR,DRBEG,DREND,DRUG,DRUGIEN,IND,FIEVT,FIEVTL 79 N NOCC,NFOUND,POI,POIBEG,POIEND,POIIEN,RXTYL 80 N SDIR,TDATE,TIND 81 S NOCC=$P(FINDPA(0),U,14) 82 I NOCC="" S NOCC=1 83 S SDIR=$S(NOCC<0:+1,1:-1) 84 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 85 ;Determine where we search. 86 D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL) 87 D GETPDR(DFN,.RXTYL,.DRBEG,.DREND,.POIBEG,.POIEND) 88 I DREND=0,POIEND=0 S FIEVAL=0 Q 89 S (DRUGIEN,NFOUND)=0 90 F S DRUGIEN=+$O(^PSDRUG(XREF,DRGRIEN,DRUGIEN)) Q:DRUGIEN=0 D 91 . I DRUGIEN'<DRBEG,DRUGIEN'>DREND S DRUG=DRUGIEN 92 . E S DRUG=0 93 .;DBIA #221 94 . S POIIEN=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 95 . I POIIEN'<POIBEG,POIIEN'>POIEND S POI=POIIEN 96 . E S POI=0 97 . K FIEVT 98 . D DEVAL^PXRMDRUG(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUG,POI,.FIEVT) 99 . I FIEVT D 100 .. S IND=0 101 .. F S IND=+$O(FIEVT(IND)) Q:IND=0 D 102 ... S NFOUND=NFOUND+1,FIEVTL(NFOUND,"DISPENSE DRUG")=DRUGIEN 103 ... M FIEVTL(NFOUND)=FIEVT(IND) 104 ... S DATEORDR(FIEVT(IND,"DATE"),NFOUND)=FIEVT(IND,"FINDING") 105 ...;Don't keep more than NOCC occurrences on the list. 106 ... I NFOUND>NOCC D 107 .... S TDATE=$O(DATEORDR(""),-SDIR),TIND=$O(DATEORDR(TDATE,"")) 108 .... K FIEVTL(TIND),DATEORDR(TDATE,TIND) 109 I NFOUND=0 S FIEVAL=0 Q 110 ;Order by date. 111 S DATE="",NFOUND=0 112 F S DATE=$O(DATEORDR(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC) D 113 . S IND=0 114 . F S IND=$O(DATEORDR(DATE,IND)) Q:(IND="")!(NFOUND=NOCC) D 115 .. S NFOUND=NFOUND+1 116 .. M FIEVAL(NFOUND)=FIEVTL(IND) 117 ;Save the finding result. 118 D SFRES^PXRMUTIL(SDIR,NFOUND,.FIEVAL) 119 Q 120 ; 121 ;================================================== 122 GETPDR(DFN,RXTYL,DRBEG,DREND,POIBEG,POIEND) ;Return the beginning drug and 123 ;ending drug for a patient. 124 N IBEG,IEND,OBEG,OEND 125 I $D(RXTYL("I")) D 126 . S IBEG=+$O(^PXRMINDX(55,"PI",DFN,0)) 127 . S IEND=+$O(^PXRMINDX(55,"PI",DFN,""),-1) 128 E S (IBEG,IEND)=0 129 I $D(RXTYL("O")) D 130 . S OBEG=+$O(^PXRMINDX(52,"PI",DFN,0)) 131 . S OEND=+$O(^PXRMINDX(52,"PI",DFN,""),-1) 132 E S (OBEG,OEND)=0 133 S DRBEG=$S(IBEG<OBEG:IBEG,1:OBEG) 134 S DREND=$S(IEND>OEND:IEND,1:OEND) 135 I $D(RXTYL("N")) D 136 . S POIBEG=+$O(^PXRMINDX("55NVA","PI",DFN,0)) 137 . S POIEND=+$O(^PXRMINDX("55NVA","PI",DFN,""),-1) 138 E S (POIBEG,POIEND)=0 139 Q 140 ; 141 ;================================================== 142 GPLIST(DRGRIEN,PFINDPA,XREF,PLIST) ; 143 N DATE,DFN,DRUGIEN,FILENUM,IND,ITEM,NFOUND,NOCC,POI,RXTYL 144 N TF,TEMP,TGLIST,TLIST 145 S TGLIST="GPLIST_PXRMDRGR" 146 K ^TMP($J,TGLIST) 147 ;Determine where we search. 148 D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL) 149 S DRUGIEN=0 150 F S DRUGIEN=$O(^PSDRUG(XREF,DRGRIEN,DRUGIEN)) Q:+DRUGIEN=0 D 151 . ;DBIA #221 152 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 153 . I $D(RXTYL("I")) D GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST) 154 . I $D(RXTYL("N")),POI'="" D GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST) 155 . I $D(RXTYL("O")) D GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST) 156 ;Return the NOCC most recent results for each DFN. 157 S NOCC=$P(FINDPA(0),U,14) 158 S NOCC=$S(NOCC<0:-NOCC,NOCC="":1,1:NOCC) 159 F TF=0,1 D 160 . S DFN=0 161 . F S DFN=$O(^TMP($J,TGLIST,TF,DFN)) Q:DFN="" D 162 .. K TLIST 163 .. S ITEM="" 164 .. F S ITEM=$O(^TMP($J,TGLIST,TF,DFN,ITEM)) Q:ITEM="" D 165 ... S NFOUND="" 166 ... F S NFOUND=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND)) Q:NFOUND="" D 167 .... S FILENUM="" 168 .... F S FILENUM=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)) Q:FILENUM="" D 169 ..... S TEMP=^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM) 170 ..... S DATE=+$P(TEMP,U,3) 171 ..... S TLIST(TF,DATE,ITEM,NFOUND,FILENUM)="" 172 .. S DATE="",NFOUND=0 173 .. F S DATE=$O(TLIST(TF,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D 174 ... S ITEM="" 175 ... F S ITEM=$O(TLIST(TF,DATE,ITEM)) Q:(ITEM="")!(NFOUND=NOCC) D 176 .... S IND="" 177 .... F S IND=$O(TLIST(TF,DATE,ITEM,IND)) Q:(IND="")!(NFOUND=NOCC) D 178 ..... S FILENUM="" 179 ..... F S FILENUM=$O(TLIST(TF,DATE,ITEM,IND,FILENUM)) Q:(FILENUM="")!(NFOUND=NOCC) D 180 ...... S NFOUND=NFOUND+1 181 ...... S ^TMP($J,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($J,TGLIST,TF,DFN,ITEM,IND,FILENUM) 182 K ^TMP($J,TGLIST) 183 Q 184 ;
Note:
See TracChangeset
for help on using the changeset viewer.
