Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLOCL.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/PXRMLOCL.m
r613 r623 1 PXRMLOCL ; SLC/PKR - Handle location findings. ;07/26/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ;This routine is for location list patient lists. 4 ;============================================= 5 ALLLOCS(SUB) ;Build a list of all hospital locations associated 6 ;with Visit file entries. 7 N HLOC 8 K ^TMP($J,SUB) 9 S HLOC="" 10 ;DBIA #2028 11 F S HLOC=$O(^AUPNVSIT("AHL",HLOC)) Q:HLOC="" S ^TMP($J,SUB,HLOC)="" 12 Q 13 ; 14 ;============================================= 15 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate location term findings 16 ;for patient lists. Return the list in ^TMP($J,PLIST) 17 N BDT,EDT,ITEM,FILENUM,PFINDPA 18 N STATUSA,TEMP,TFINDING,TFINDPA 19 S FILENUM=$$GETFNUM^PXRMDATA(ENODE) 20 S ITEM="" 21 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D 22 . S TFINDING="" 23 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D 24 .. K PFINDPA,TFINDPA 25 .. M TFINDPA=TERMARR(20,TFINDING) 26 ..;Set the finding parameters. 27 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 28 .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST) 29 Q 30 ; 31 ;============================================= 32 FPLIST(FILENUM,HLOCL,NOCC,BDT,EDT,PLIST) ;Find patient list data for 33 ;a visit to a hospital location. Return the list in ^TMP($J,PLIST). 34 N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED 35 N NFOUND,SC,TEMP,TGLIST,TIME 36 S TGLIST="FPLIST_PXRMLOCL" 37 K ^TMP($J,TGLIST) 38 S DEND=$S(EDT[".":EDT,1:EDT+.235959) 39 ;"AHL" in Visit file is inverse date_.time instead of a full inverse 40 ;date and time. For example if the date/time is 3030704.104449 then 41 ;"AHL" has 6969295.104449 instead of 6969295.89555 42 S INVBD=9999999-$P(BDT,".",1),BTIME="."_$P(BDT,".",2) 43 S INVED=9999999-$P(DEND,".",1),ETIME="."_$P(DEND,".",2) 44 S DS=INVED-.000001 45 S HLOC="" 46 F S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:HLOC="" D 47 . S INVDT=DS,DONE=0 48 .;DBIA #2028 49 . F S INVDT=$O(^AUPNVSIT("AHL",HLOC,INVDT)) Q:(DONE)!(INVDT="") D 50 .. S INVDATE=$P(INVDT,".",1) 51 .. I INVDATE>INVBD S DONE=1 Q 52 .. S TIME="."_$P(INVDT,".",2) 53 .. I INVDATE=INVED,TIME>ETIME Q 54 .. I INVDATE=INVBD,TIME<BTIME Q 55 .. S DAS=0 56 .. F S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS="" D 57 ...;Check the associated appointment for a valid status. 58 ... I '$$VAPSTAT^PXRMVSIT(DAS) Q 59 ... S TEMP=^AUPNVSIT(DAS,0) 60 ... S DATE=$P(TEMP,U,1) 61 ... S DFN=$P(TEMP,U,5) 62 ... S SC=$P(TEMP,U,7) 63 ... S ^TMP($J,TGLIST,DFN,INVDT,DAS)=DATE_U_HLOC_U_SC 64 ;Return the NOCC most recent for each patient. 65 S DFN=0 66 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 67 . S (INVDT,NFOUND)=0 68 . F S INVDT=$O(^TMP($J,TGLIST,DFN,INVDT)) Q:(NFOUND=NOCC)!(INVDT="") D 69 .. S DAS="" 70 .. F S DAS=$O(^TMP($J,TGLIST,DFN,INVDT,DAS)) Q:(NFOUND=NOCC)!(DAS="") D 71 ... S NFOUND=NFOUND+1 72 ... S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_^TMP($J,TGLIST,DFN,INVDT,DAS) 73 K ^TMP($J,TGLIST) 74 Q 75 ; 76 ;============================================= 77 FTEST(FILENUM,HLOCL,NOCC,BDT,EDT,PLIST) ;Find patient list data for 78 ;a visit to a hospital location. Return the list in ^TMP($J,PLIST). 79 N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED 80 N NFOUND,TEMP,TGLIST,TIME 81 S TGLIST="FPLIST_PXRMLOCL" 82 K ^TMP($J,TGLIST) 83 S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001) 84 S HLOC="" 85 F S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:HLOC="" D 86 . S DATE=DS 87 . F S DATE=+$O(^AUPNVSIT("AHDP",HLOC,DATE),-1) Q:(DATE=0)!(DATE<BDT) D 88 .. S DFN="" 89 .. F S DFN=$O(^AUPNVSIT("AHDP",HLOC,DATE,DFN)) Q:DFN="" D 90 ... S SC="" 91 ... F S SC=$O(^AUPNVSIT("AHDP",HLOC,DATE,DFN,SC)) Q:SC="" D 92 .... S DAS=$O(^AUPNVSIT("AHDP",HLOC,DATE,DFN,SC,"")) 93 .... I '$$VAPSTAT^PXRMVSIT(DAS) Q 94 .... S ^TMP($J,TGLIST,DFN,DATE,DAS)=HLOC 95 ;Return the NOCC most recent for each patient. 96 S DFN=0 97 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 98 . S DATE="",NFOUND=0 99 . F S DATE=$O(^TMP($J,TGLIST,DFN,DATE),-1) Q:(NFOUND=NOCC)!(DATE="") D 100 .. S DAS="" 101 .. F S DAS=$O(^TMP($J,TGLIST,DFN,DATE,DAS)) Q:(NFOUND=NOCC)!(DAS="") D 102 ... S NFOUND=NFOUND+1 103 ... S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_DATE_U_^TMP($J,TGLIST,DFN,DATE,DAS) 104 K ^TMP($J,TGLIST) 105 Q 106 ; 107 ;============================================= 108 GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list. 109 ; Return the list in ^TMP($J,PLIST). 110 ;^TMP($J,PLIST,T/F,DFN,IND,FILENUM)=DAS^DATE^HLOC^VALUE 111 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST 112 N ICOND,IEN,IND,IPLIST,LNAME,NOCC,NFOUND,NGET,NP,SAVE,STATUSA 113 N TEMP,TGLIST,TPLIST,UCIFS,VALUE,VSLIST 114 S TGLIST="GPLIST_PXRMLOCL" 115 ;Set the finding search parameters. 116 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 117 ;Ignore negative occurrence count, date reversal not allowed in 118 ;patient lists. 119 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 120 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST) 121 S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC) 122 ;Get a list of unique locations. 123 S LNAME=$P(^PXRMD(810.9,ITEM,0),U,1) 124 I LNAME="VA-ALL LOCATIONS" D ALLLOCS("HLOCL") 125 I LNAME'="VA-ALL LOCATIONS" D LOCLIST^PXRMLOCF(ITEM,"HLOCL") 126 D FPLIST(FILENUM,"HLOCL",NGET,BDT,EDT,TGLIST) 127 S DFN="" 128 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 129 . K TPLIST 130 . M TPLIST=^TMP($J,TGLIST,DFN) 131 . S (IND,NFOUND)=0 132 . K IPLIST 133 . F S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D 134 .. S TEMP=TPLIST(IND) 135 .. S DAS=$P(TEMP,U,1) 136 .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD) 137 .. S VALUE=$G(FIEVD("VALUE")) 138 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1) 139 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0) 140 .. I SAVE D 141 ... S NFOUND=NFOUND+1 142 ... S IPLIST(CONVAL,DFN,NFOUND,FILENUM)=TEMP_U_VALUE 143 . M ^TMP($J,PLIST)=IPLIST 144 K ^TMP($J,"HLOCL"),^TMP($J,TGLIST) 145 Q 146 ; 147 ;============================================= 148 PCSTOPL ;Print the Clinic Stop list. Called by the print template PXRM 149 ;LOCATION LIST INQUIRY. 150 N AMIS,CSTOP,IND,JND,SKIP,TEMP 151 S (IND,SKIP)=0 152 F S IND=+$O(^PXRMD(810.9,D0,40.7,IND)) Q:IND=0 D 153 . S TEMP=^PXRMD(810.9,D0,40.7,IND,0) 154 . S CSTOP=$P(TEMP,U,1) 155 .; DBIA #557 156 . S CSTOP=$P(^DIC(40.7,CSTOP,0),U,1) 157 . S AMIS=$P(TEMP,U,2) 158 . I SKIP W ! S SKIP=0 159 . W !,?2,CSTOP,?34,AMIS 160 . I '$D(^PXRMD(810.9,D0,40.7,IND,1)) Q 161 . S SKIP=1 162 . W !,?4,"Credit Stops to Exclude:" 163 . S JND=0 164 . F S JND=+$O(^PXRMD(810.9,D0,40.7,IND,1,JND)) Q:JND=0 D 165 .. S TEMP=^PXRMD(810.9,D0,40.7,IND,1,JND,0) 166 .. S TEMP=$P(^DIC(40.7,TEMP,0),U,1,2) 167 .. S CSTOP=$P(TEMP,U,1) 168 .. S AMIS=$P(TEMP,U,2) 169 .. W !,?6,CSTOP,?38,AMIS 170 Q 171 ; 1 PXRMLOCL ; SLC/PKR - Handle location findings. ;07/17/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ;This routine is for location list patient lists. 4 ;============================================= 5 ALLLOCS(SUB) ;Build a list of all hospital locations associated 6 ;with Visit file entries. 7 N HLOC 8 K ^TMP($J,SUB) 9 S HLOC="" 10 ;DBIA #2028 11 F S HLOC=$O(^AUPNVSIT("AHL",HLOC)) Q:HLOC="" S ^TMP($J,SUB,HLOC)="" 12 Q 13 ; 14 ;============================================= 15 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate location term findings 16 ;for patient lists. Return the list in ^TMP($J,PLIST) 17 N BDT,EDT,ITEM,FILENUM,PFINDPA 18 N STATUSA,TEMP,TFINDING,TFINDPA 19 S FILENUM=$$GETFNUM^PXRMDATA(ENODE) 20 S ITEM="" 21 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D 22 . S TFINDING="" 23 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D 24 .. K PFINDPA,TFINDPA 25 .. M TFINDPA=TERMARR(20,TFINDING) 26 ..;Set the finding parameters. 27 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 28 .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST) 29 Q 30 ; 31 ;============================================= 32 FPLIST(FILENUM,HLOCL,NOCC,BDT,EDT,PLIST) ;Find patient list data for 33 ;a visit to a hospital location. Return the list in ^TMP($J,PLIST). 34 N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED 35 N NFOUND,TEMP,TGLIST,TIME 36 S TGLIST="FPLIST_PXRMLOCL" 37 K ^TMP($J,TGLIST) 38 S DEND=$S(EDT[".":EDT,1:EDT+.240001) 39 ;"AHL" in Visit file is inverse date_.time instead of a full inverse 40 ;date and time. For example if the date/time is 3030704.104449 then 41 ;"AHL" has 6969295.104449 instead of 6969295.89555 42 S INVBD=9999999-$P(BDT,".",1),BTIME=+("."_$P(BDT,".",2)) 43 S INVED=9999999-$P(DEND,".",1),ETIME=+("."_$P(DEND,".",2)) 44 S DS=INVED-1 45 S HLOC="" 46 F S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:HLOC="" D 47 . S INVDT=DS,DONE=0 48 .;DBIA #2028 49 . F S INVDT=$O(^AUPNVSIT("AHL",HLOC,INVDT)) Q:(DONE)!(INVDT="") D 50 .. S INVDATE=$P(INVDT,".",1) 51 .. I INVDATE>INVBD S DONE=1 Q 52 .. S TIME=+("."_$P(INVDT,".",2)) 53 .. I INVDATE=INVED,TIME>ETIME Q 54 .. I INVDATE=INVBD,BTIME>TIME S DONE=1 Q 55 .. S DAS=0 56 .. F S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS="" D 57 ...;Check the associated appointment for a valid status. 58 ... I '$$VAPSTAT^PXRMVSIT(DAS) Q 59 ... S TEMP=^AUPNVSIT(DAS,0) 60 ... S DFN=$P(TEMP,U,5) 61 ... S DATE=$P(TEMP,U,1) 62 ... S ^TMP($J,TGLIST,DFN,INVDT,DAS)=DATE_U_HLOC 63 ;Return the NOCC most recent for each patient. 64 S DFN=0 65 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 66 . S (INVDT,NFOUND)=0 67 . F S INVDT=$O(^TMP($J,TGLIST,DFN,INVDT)) Q:(NFOUND=NOCC)!(INVDT="") D 68 .. S DAS="" 69 .. F S DAS=$O(^TMP($J,TGLIST,DFN,INVDT,DAS)) Q:(NFOUND=NOCC)!(DAS="") D 70 ... S NFOUND=NFOUND+1 71 ... S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_^TMP($J,TGLIST,DFN,INVDT,DAS) 72 K ^TMP($J,TGLIST) 73 Q 74 ; 75 ;============================================= 76 GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list. 77 ; Return the list in ^TMP($J,PLIST). 78 ;^TMP($J,PLIST,T/F,DFN,IND,FILENUM)=DAS^DATE^HLOC^VALUE 79 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST 80 N ICOND,IEN,IND,IPLIST,LNAME,NOCC,NFOUND,NGET,NP,SAVE,STATUSA 81 N TEMP,TGLIST,TPLIST,UCIFS,VALUE,VSLIST 82 S TGLIST="GPLIST_PXRMLOCL" 83 ;Set the finding search parameters. 84 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT) 85 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 86 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST) 87 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC) 88 ;Get a list of unique locations. 89 S LNAME=$P(^PXRMD(810.9,ITEM,0),U,1) 90 I LNAME="VA-ALL LOCATIONS" D ALLLOCS("HLOCL") 91 I LNAME'="VA-ALL LOCATIONS" D LOCLIST^PXRMLOCF(ITEM,"HLOCL") 92 D FPLIST(FILENUM,"HLOCL",NGET,BDT,EDT,TGLIST) 93 S DFN="" 94 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D 95 . K TPLIST 96 . M TPLIST=^TMP($J,TGLIST,DFN) 97 . S (IND,NFOUND)=0 98 . K IPLIST 99 . F S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D 100 .. S TEMP=TPLIST(IND) 101 .. S DAS=$P(TEMP,U,1) 102 .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD) 103 .. S VALUE=$G(FIEVD("VALUE")) 104 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1) 105 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0) 106 .. I SAVE D 107 ... S NFOUND=NFOUND+1 108 ... S IPLIST(CONVAL,DFN,NFOUND,FILENUM)=TEMP_U_VALUE 109 . M ^TMP($J,PLIST)=IPLIST 110 K ^TMP($J,"HLOCL"),^TMP($J,TGLIST) 111 Q 112 ; 113 ;============================================= 114 PCSTOPL ;Print the Clinic Stop list. Called by the print template PXRM 115 ;LOCATION LIST INQUIRY. 116 N AMIS,CSTOP,IND,JND,SKIP,TEMP 117 S (IND,SKIP)=0 118 F S IND=+$O(^PXRMD(810.9,D0,40.7,IND)) Q:IND=0 D 119 . S TEMP=^PXRMD(810.9,D0,40.7,IND,0) 120 . S CSTOP=$P(TEMP,U,1) 121 .; DBIA #557 122 . S CSTOP=$P(^DIC(40.7,CSTOP,0),U,1) 123 . S AMIS=$P(TEMP,U,2) 124 . I SKIP W ! S SKIP=0 125 . W !,?2,CSTOP,?34,AMIS 126 . I '$D(^PXRMD(810.9,D0,40.7,IND,1)) Q 127 . S SKIP=1 128 . W !,?4,"Credit Stops to Exclude:" 129 . S JND=0 130 . F S JND=+$O(^PXRMD(810.9,D0,40.7,IND,1,JND)) Q:JND=0 D 131 .. S TEMP=^PXRMD(810.9,D0,40.7,IND,1,JND,0) 132 .. S TEMP=$P(^DIC(40.7,TEMP,0),U,1,2) 133 .. S CSTOP=$P(TEMP,U,1) 134 .. S AMIS=$P(TEMP,U,2) 135 .. W !,?6,CSTOP,?38,AMIS 136 Q 137 ;
Note:
See TracChangeset
for help on using the changeset viewer.
