Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEUT.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/PXRMEUT.m
r613 r623 1 PXRMEUT ; SLC/PJH - General extract utilities ;09/06/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;================================================= 5 ASKNUM(TEXT,MIN,MAX) ; 6 N DIR,X,Y 7 K DIROUT,DIRUT,DTOUT,DUOUT 8 S DIR(0)="N"_U_MIN_":"_MAX 9 S DIR("A")=TEXT 10 S DIR("B")=MIN 11 S DIR("?")="Enter a number between "_MIN_" and "_MAX_"." 12 W ! 13 D ^DIR 14 I $D(DTOUT)!$D(DUOUT) S Y=MIN 15 Q Y 16 ; 17 ;================================================= 18 ASKYN(DEF,TEXT,RTN,HLP) ; 19 N DIR,X,Y 20 K DIROUT,DIRUT,DTOUT,DUOUT 21 S DIR(0)="Y0" 22 S DIR("A")=TEXT 23 S DIR("B")=DEF 24 S DIR("?")="Enter Y or N." 25 I $G(RTN)'="",$G(HLP)'="" D 26 . S DIR("?")="Enter Y or N. For detailed help type ??" 27 . S DIR("??")=U_"D HELP^"_RTN_"(HLP)" 28 W ! 29 D ^DIR 30 I $D(DTOUT)!$D(DUOUT) S Y=DEF 31 Q Y 32 ; 33 ;================================================= 34 BHELP ;Write the beginning date help. 35 N BDHTEXT,%DT 36 S BDHTEXT(1)="This is the beginning date for the "_LIT_"." 37 D HELP^PXRMEUT(.BDHTEXT) 38 S %DT="P",%DT(0)=-DT 39 D HELP^%DTC 40 Q 41 ; 42 ;================================================= 43 CALC(NEXT,START,END) ;Calculate period start and end dates 44 ;Next is current run period 45 N CMON,CYR,ETYPE,NMON,NYR,PERIOD,YEAR 46 ;extract year and period (M1,M2,Q1,Q2,Y etc) 47 I NEXT["/" S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/"),ETYPE=$E(PERIOD) 48 I NEXT?4N S YEAR=NEXT,PERIOD="",ETYPE="Y" 49 ;Two digit year 50 S CYR=$E(YEAR,3,4),NYR=CYR 51 ;If yearly use Jan 1st of current year and next 52 I ETYPE="Y" D 53 .S CMON="1",NMON="1",NYR=NYR+1 54 ;If quarterly use start of first month of next quarter 55 I ETYPE="Q" D 56 .S CMON=$E(PERIOD,2,99),NMON=CMON*3+1 I NMON>12 S NYR=NYR+1,NMON=1 57 .S CMON=CMON*3-2 58 ;If monthly use start of next month 59 I ETYPE="M" D 60 .S CMON=$E(PERIOD,2,99),NMON=CMON+1 I NMON>12 S NYR=NYR+1,NMON=1 61 ;Zero fill the month fields 62 S CMON=$$RJ^XLFSTR(CMON,2,0),NMON=$$RJ^XLFSTR(NMON,2,0) 63 ;Zero fill the year fields 64 S CYR=$$RJ^XLFSTR(CYR,2,0),NYR=$$RJ^XLFSTR(NYR,2,0) 65 ;Report start date is start of current period 66 S START=3_CYR_CMON_"01" 67 ;Report end date is start of next period less one day 68 S END=$$FMADD^XLFDT(3_NYR_NMON_"01",-1) 69 Q 70 ; 71 ;================================================= 72 DATES(BDATE,EDATE,LIT) ;Get a past date range. 73 BEGIN ;Select the beginning date. 74 N DIR,%DT,X,Y 75 K DIROUT,DIRUT,DTOUT,DUOUT 76 S DIR(0)="DA^::ETX" 77 S DIR("A")="Enter "_LIT_" BEGINNING DATE: " 78 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 79 S DIR("?")="For detailed help type ??" 80 S DIR("??")=U_"D BHELP^PXRMEUT" 81 W ! 82 D ^DIR K DIR 83 I $D(DIROUT) S DTOUT=1 84 I $D(DTOUT)!($D(DUOUT)) Q 85 S BDATE=Y 86 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G BEGIN 87 S BDATE=Y 88 ; 89 END ;Select the ending date. 90 S DIR(0)="DA^"_BDATE_"::ETX" 91 S DIR("A")="Enter "_LIT_" ENDING DATE: " 92 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 93 S DIR("?")="This date cannot be before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??" 94 S DIR("??")=U_"D EHELP^PXRMEUT" 95 D ^DIR 96 I $D(DIROUT) S DTOUT=1 97 I $D(DTOUT) Q 98 I $D(DUOUT) G BEGIN 99 S EDATE=Y 100 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G END 101 K DIROUT,DIRUT,DTOUT,DUOUT 102 Q 103 ; 104 ;================================================= 105 DOCUMENT(PXRMLIST,PXRMRULE,INDP,INTP,BEG,END) ;Document how the 106 ;list was built. 107 N CDATE,CLASS,CREATOR,IND,LDATA,LNAME 108 N NDL,NL,NPAT,OUTPUT,SNAME,SOURCE,TEXT,TYPE,VALMCNT 109 K ^TMP("PXRMLRED",$J) 110 S LDATA=$G(^PXRMXP(810.5,PXRMLIST,0)) 111 S LNAME=$P(LDATA,U,1) 112 S CDATE=$P(LDATA,U,4) 113 S SOURCE=$P(LDATA,U,5),SNAME="NONE" 114 ;Check if generated from #810.2 115 I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U) 116 ;If not check if generated from #810.4 117 I 'SOURCE S SOURCE=$P(LDATA,U,6) S:SOURCE SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U) 118 ;Creator 119 S CREATOR=+$P(LDATA,U,7) 120 S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None") 121 ;Type 122 S TYPE=$P(LDATA,U,8) 123 S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM) 124 ;Class 125 S CLASS=$P($G(^PXRMXP(810.5,PXRMLIST,100)),U,1) 126 S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local") 127 S NPAT=$P(^PXRMXP(810.5,PXRMLIST,30,0),U,4) 128 S TEXT(1)="List Name: "_LNAME_" ("_NPAT_" patients)" 129 S TEXT(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z") 130 S TEXT(2)=$$LJ^XLFSTR(TEXT(2),40)_"Creator: "_CREATOR 131 S TEXT(3)=" Class: "_CLASS 132 S TEXT(3)=$$LJ^XLFSTR(TEXT(3),40)_"Type: "_TYPE 133 S TEXT(4)=" Source: "_SNAME 134 S TEXT(5)=" Patient List Beginning Date: "_$$FMTE^XLFDT(BEG,"5Z") 135 S TEXT(6)=" Patient List Ending Date: "_$$FMTE^XLFDT(END,"5Z") 136 S TEXT(7)=" " 137 S NL=7 138 F IND=1:1:NL S ^PXRMXP(810.5,PXRMLIST,200,IND,0)=TEXT(IND) 139 D BLDLIST^PXRMLRED(PXRMRULE,3) 140 F IND=1:1:VALMCNT S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=^TMP("PXRMLRED",$J,IND,0) 141 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=" --- List Build Information ---" 142 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="List Build Beginning Date: "_$$FMTE^XLFDT(BEG,"5Z") 143 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="List Build Ending Date: "_$$FMTE^XLFDT(END,"5Z") 144 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=" " 145 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="Include deceased patients: "_$S(INDP:"Yes",1:"No") 146 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="Include test patients: "_$S(INTP:"Yes",1:"No") 147 ;Get the beginning and ending date information 148 D DOCDATES^PXRMEUT1(PXRMRULE,BEG,END,.NDL,.OUTPUT) 149 F IND=1:1:NDL S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=OUTPUT(IND) 150 S ^PXRMXP(810.5,PXRMLIST,200,0)=U_U_NL_U_NL_U_DT_U 151 K ^TMP("PXRMLRED",$J) 152 Q 153 ; 154 ;================================================= 155 EHELP ;Write the ending date help. 156 N EDHTEXT,%DT 157 S EDHTEXT(1)="This is the ending date for the "_LIT_"." 158 D HELP^PXRMEUT(.EDHTEXT) 159 S %DT="P",%DT(0)=-DT 160 D HELP^%DTC 161 Q 162 ; 163 ;================================================= 164 HELP(HTEXT) ;General help text output routine. 165 N IND,NIN,NOUT,TEXTIN,TEXOUT 166 ;Make sure the text is in a form the formatting routine can handle. 167 S IND="",NIN=0 168 F S IND=$O(HTEXT(IND)) Q:IND="" S NIN=NIN+1,TEXTIN(NIN)=HTEXT(IND) 169 D FORMAT^PXRMTEXT(1,72,NIN,.TEXTIN,.NOUT,.TEXTOUT) 170 F IND=1:1:NOUT W !,TEXTOUT(IND) 171 W ! 172 Q 173 ; 174 ;================================================= 175 LDELOK(LISTIEN) ;Return a 1 if it is ok for this user to delete the list. 176 N CREATOR,DELOK 177 S CREATOR=$P(^PXRMXP(810.5,LISTIEN,0),U,7) 178 S DELOK=$S(CREATOR=DUZ:1,$D(^XUSEC("PXRM MANAGER",DUZ)):1,1:0) 179 Q DELOK 180 ; 181 ;================================================= 182 MES(TEXT) ;General mail message 183 N XMSUB 184 K ^TMP("PXRMXMZ",$J) 185 S XMSUB="CLINICAL REMINDER EXTRACT" 186 S ^TMP("PXRMXMZ",$J,1,0)=TEXT 187 D SEND^PXRMMSG(XMSUB) 188 Q 189 ; 190 ;================================================= 191 PERIOD(FREQ) ;Calculate next period 192 N CMON,CUR,CYR,ETYPE,NEXT,PERIOD,YEAR 193 ;Format current date YY/MM/DD 194 S CUR=$$FMTE^XLFDT($$NOW^XLFDT,7) 195 ;extract year and period 196 S YEAR=$P(CUR,"/"),PERIOD=$P(CUR,"/",2) 197 ;If yearly current year 198 I FREQ="Y" D 199 .S NEXT=YEAR 200 ;If quarterly use current quarter 201 I FREQ="Q" D 202 .S NEXT="Q"_((PERIOD-1\3)+1)_"/"_YEAR 203 ;If monthly use current month 204 I FREQ="M" D 205 .S NEXT="M"_PERIOD_"/"_YEAR 206 Q NEXT 207 ; 208 ;================================================= 209 RMPAT(NODE,INDP,INTP) ;Remove dead and test patients from 210 ;the list. 211 I INDP,INTP Q 212 N DFN,DOD,REMOVE 213 S DFN=0 214 F S DFN=$O(^TMP($J,NODE,DFN)) Q:DFN="" D 215 .;DBIA 3744 216 . S REMOVE=$S('INTP:$$TESTPAT^VADPT(DFN),1:0) 217 . I REMOVE K ^TMP($J,NODE,DFN) Q 218 . I INDP Q 219 .;DBIA #10035 220 . S DOD=+$P($G(^DPT(DFN,.35)),U,1) 221 . I DOD=0 Q 222 . K ^TMP($J,NODE,DFN) 223 Q 224 ; 1 PXRMEUT ; SLC/PJH - General extract utilities ;06/27/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;================================================= 5 ASKNUM(TEXT,MIN,MAX) ; 6 N DIR,X,Y 7 K DIROUT,DIRUT,DTOUT,DUOUT 8 S DIR(0)="N"_U_MIN_":"_MAX 9 S DIR("A")=TEXT 10 S DIR("B")=MIN 11 S DIR("?")="Enter a number between "_MIN_" and "_MAX_"." 12 W ! 13 D ^DIR 14 I $D(DTOUT)!$D(DUOUT) S Y=MIN 15 Q Y 16 ; 17 ;================================================= 18 ASKYN(DEF,TEXT,RTN,HLP) ; 19 N DIR,X,Y 20 K DIROUT,DIRUT,DTOUT,DUOUT 21 S DIR(0)="Y0" 22 S DIR("A")=TEXT 23 S DIR("B")=DEF 24 S DIR("?")="Enter Y or N." 25 I $G(RTN)'="",$G(HLP)'="" D 26 . S DIR("?")="Enter Y or N. For detailed help type ??" 27 . S DIR("??")=U_"D HELP^"_RTN_"(HLP)" 28 W ! 29 D ^DIR 30 I $D(DTOUT)!$D(DUOUT) S Y=DEF 31 Q Y 32 ; 33 ;================================================= 34 BHELP ;Write the beginning date help. 35 N BDHTEXT,%DT 36 S BDHTEXT(1)="This is the beginning date for the "_LIT_"." 37 D HELP^PXRMEUT(.BDHTEXT) 38 S %DT="P",%DT(0)=-DT 39 D HELP^%DTC 40 Q 41 ; 42 ;================================================= 43 CALC(NEXT,START,END) ;Calculate period start and end dates 44 ;Next is current run period 45 N CMON,CYR,ETYPE,NMON,NYR,PERIOD,YEAR 46 ;extract year and period (M1,M2,Q1,Q2,Y etc) 47 I NEXT["/" S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/"),ETYPE=$E(PERIOD) 48 I NEXT?4N S YEAR=NEXT,PERIOD="",ETYPE="Y" 49 ;Two digit year 50 S CYR=$E(YEAR,3,4),NYR=CYR 51 ;If yearly use Jan 1st of current year and next 52 I ETYPE="Y" D 53 .S CMON="1",NMON="1",NYR=NYR+1 54 ;If quarterly use start of first month of next quarter 55 I ETYPE="Q" D 56 .S CMON=$E(PERIOD,2,99),NMON=CMON*3+1 I NMON>12 S NYR=NYR+1,NMON=1 57 .S CMON=CMON*3-2 58 ;If monthly use start of next month 59 I ETYPE="M" D 60 .S CMON=$E(PERIOD,2,99),NMON=CMON+1 I NMON>12 S NYR=NYR+1,NMON=1 61 ;Zero fill the month fields 62 S CMON=$$RJ^XLFSTR(CMON,2,0),NMON=$$RJ^XLFSTR(NMON,2,0) 63 ;Zero fill the year fields 64 S CYR=$$RJ^XLFSTR(CYR,2,0),NYR=$$RJ^XLFSTR(NYR,2,0) 65 ;Report start date is start of current period 66 S START=3_CYR_CMON_"01" 67 ;Report end date is start of next period less one day 68 S END=$$FMADD^XLFDT(3_NYR_NMON_"01",-1) 69 Q 70 ; 71 ;================================================= 72 DATES(BDATE,EDATE,LIT) ;Get a past date range. 73 BEGIN ;Select the beginning date. 74 N DIR,%DT,X,Y 75 K DIROUT,DIRUT,DTOUT,DUOUT 76 S DIR(0)="DA^::ETX" 77 S DIR("A")="Enter "_LIT_" BEGINNING DATE: " 78 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 79 S DIR("?")="For detailed help type ??" 80 S DIR("??")=U_"D BHELP^PXRMEUT" 81 W ! 82 D ^DIR K DIR 83 I $D(DIROUT) S DTOUT=1 84 I $D(DTOUT)!($D(DUOUT)) Q 85 S BDATE=Y 86 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G BEGIN 87 S BDATE=Y 88 ; 89 END ;Select the ending date. 90 S DIR(0)="DA^"_BDATE_"::ETX" 91 S DIR("A")="Enter "_LIT_" ENDING DATE: " 92 S DIR("PRE")="S X=$$DCHECK^PXRMDATE(X) K:X=-1 X" 93 S DIR("?")="This date cannot be before "_$$FMTE^XLFDT(BDATE,"D")_". For detailed help type ??" 94 S DIR("??")=U_"D EHELP^PXRMEUT" 95 D ^DIR 96 I $D(DIROUT) S DTOUT=1 97 I $D(DTOUT) Q 98 I $D(DUOUT) G BEGIN 99 S EDATE=Y 100 I $E(Y,6,7)="00" W $C(7)," ?? Enter exact date" G END 101 K DIROUT,DIRUT,DTOUT,DUOUT 102 Q 103 ; 104 ;================================================= 105 DOCUMENT(PXRMLIST,PXRMRULE,INDP,INTP,BEG,END) ;Document how the 106 ;list was built. 107 N CDATE,CLASS,CREATOR,IND,LDATA,LNAME 108 N NDL,NL,NPAT,OUTPUT,SNAME,SOURCE,TEXT,TYPE,VALMCNT 109 K ^TMP("PXRMLRED",$J) 110 S LDATA=$G(^PXRMXP(810.5,PXRMLIST,0)) 111 S LNAME=$P(LDATA,U,1) 112 S CDATE=$P(LDATA,U,4) 113 S SOURCE=$P(LDATA,U,5),SNAME="NONE" 114 ;Check if generated from #810.2 115 I SOURCE S SNAME="Extract Parameter - "_$P($G(^PXRM(810.2,SOURCE,0)),U) 116 ;If not check if generated from #810.4 117 I 'SOURCE S SOURCE=$P(LDATA,U,6) S:SOURCE SNAME="List Rule - "_$P($G(^PXRM(810.4,SOURCE,0)),U) 118 ;Creator 119 S CREATOR=+$P(LDATA,U,7) 120 S CREATOR=$S(CREATOR>0:$$GET1^DIQ(200,CREATOR,.01),1:"None") 121 ;Type 122 S TYPE=$P(LDATA,U,8) 123 S TYPE=$$EXTERNAL^DILFD(810.5,.08,"",TYPE,.EM) 124 ;Class 125 S CLASS=$P($G(^PXRMXP(810.5,PXRMLIST,100)),U,1) 126 S CLASS=$S(CLASS="N":"National",CLASS="V":"VISN",1:"Local") 127 S NPAT=$P(^PXRMXP(810.5,PXRMLIST,30,0),U,4) 128 S TEXT(1)="List Name: "_LNAME_" ("_NPAT_" patients)" 129 S TEXT(2)=" Created: "_$$FMTE^XLFDT(CDATE,"5Z") 130 S TEXT(2)=$$LJ^XLFSTR(TEXT(2),40)_"Creator: "_CREATOR 131 S TEXT(3)=" Class: "_CLASS 132 S TEXT(3)=$$LJ^XLFSTR(TEXT(3),40)_"Type: "_TYPE 133 S TEXT(4)=" Source: "_SNAME 134 S TEXT(5)=" Patient List Beginning Date: "_$$FMTE^XLFDT(BEG,"5Z") 135 S TEXT(6)=" Patient List Ending Date: "_$$FMTE^XLFDT(END,"5Z") 136 S TEXT(7)=" " 137 S NL=7 138 F IND=1:1:NL S ^PXRMXP(810.5,PXRMLIST,200,IND,0)=TEXT(IND) 139 D BLDLIST^PXRMLRED(PXRMRULE,3) 140 F IND=1:1:VALMCNT S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=^TMP("PXRMLRED",$J,IND,0) 141 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=" --- List Build Information ---" 142 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="List Build Beginning Date: "_$$FMTE^XLFDT(BEG,"5Z") 143 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="List Build Ending Date: "_$$FMTE^XLFDT(END,"5Z") 144 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=" " 145 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="Include deceased patients: "_$S(INDP:"Yes",1:"No") 146 S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)="Include test patients: "_$S(INTP:"Yes",1:"No") 147 ;Get the beginning and ending date information 148 D DOCDATES^PXRMEUT1(PXRMRULE,BEG,END,.NDL,.OUTPUT) 149 F IND=1:1:NDL S NL=NL+1,^PXRMXP(810.5,PXRMLIST,200,NL,0)=OUTPUT(IND) 150 S ^PXRMXP(810.5,PXRMLIST,200,0)=U_U_NL_U_NL_U_DT_U 151 K ^TMP("PXRMLRED",$J) 152 Q 153 ; 154 ;================================================= 155 EHELP ;Write the ending date help. 156 N EDHTEXT,%DT 157 S EDHTEXT(1)="This is the ending date for the "_LIT_"." 158 D HELP^PXRMEUT(.EDHTEXT) 159 S %DT="P",%DT(0)=-DT 160 D HELP^%DTC 161 Q 162 ; 163 ;================================================= 164 HELP(HTEXT) ;General help text routine. Write out the text in the HTEXT 165 ;array. 166 N DIWF,DIWL,DIWR,IC,X 167 S DIWF="C70",DIWL=0,DIWR=70 168 K ^UTILITY($J,"W") 169 S IC="" 170 F S IC=$O(HTEXT(IC)) Q:IC="" D 171 . S X=HTEXT(IC) 172 . D ^DIWP 173 W ! 174 S IC=0 175 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 176 . W !,^UTILITY($J,"W",0,IC,0) 177 K ^UTILITY($J,"W") 178 W ! 179 Q 180 ; 181 ;================================================= 182 LDELOK(LISTIEN) ;Return a 1 if it is ok for this user to delete the list. 183 N CREATOR,DELOK 184 S CREATOR=$P(^PXRMXP(810.5,LISTIEN,0),U,7) 185 S DELOK=$S(CREATOR=DUZ:1,$D(^XUSEC("PXRM MANAGER",DUZ)):1,1:0) 186 Q DELOK 187 ; 188 ;================================================= 189 MES(TEXT) ;General mail message 190 N XMSUB 191 K ^TMP("PXRMXMZ",$J) 192 S XMSUB="CLINICAL REMINDER EXTRACT" 193 S ^TMP("PXRMXMZ",$J,1,0)=TEXT 194 D SEND^PXRMMSG(XMSUB) 195 Q 196 ; 197 ;================================================= 198 PERIOD(FREQ) ;Calculate next period 199 N CMON,CUR,CYR,ETYPE,NEXT,PERIOD,YEAR 200 ;Format current date YY/MM/DD 201 S CUR=$$FMTE^XLFDT($$NOW^XLFDT,7) 202 ;extract year and period 203 S YEAR=$P(CUR,"/"),PERIOD=$P(CUR,"/",2) 204 ;If yearly current year 205 I FREQ="Y" D 206 .S NEXT=YEAR 207 ;If quarterly use current quarter 208 I FREQ="Q" D 209 .S NEXT="Q"_((PERIOD-1\3)+1)_"/"_YEAR 210 ;If monthly use current month 211 I FREQ="M" D 212 .S NEXT="M"_PERIOD_"/"_YEAR 213 Q NEXT 214 ; 215 ;================================================= 216 RMPAT(NODE,INDP,INTP) ;Remove dead and test patients from 217 ;the list. 218 I INDP,INTP Q 219 N DFN,DOD,REMOVE 220 S DFN=0 221 F S DFN=$O(^TMP($J,NODE,DFN)) Q:DFN="" D 222 .;DBIA 3744 223 . S REMOVE=$S('INTP:$$TESTPAT^VADPT(DFN),1:0) 224 . I REMOVE K ^TMP($J,NODE,DFN) Q 225 . I INDP Q 226 .;DBIA #10035 227 . S DOD=+$P($G(^DPT(DFN,.35)),U,1) 228 . I DOD=0 Q 229 . K ^TMP($J,NODE,DFN) 230 Q 231 ;
Note:
See TracChangeset
for help on using the changeset viewer.
