Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDATE.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/PXRMDATE.m
r613 r623 1 PXRMDATE ; SLC/PKR - Clinical Reminders date utilities. ;01/24/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;================================================== 5 CEFD(FDA) ;Called by the Exchange Utility only if the input packed 6 ;reminder was packed under v1.5 Move Effective Date to Beginning Date. 7 N IND 8 S IND="" 9 F S IND=$O(FDA(811.902,IND)) Q:IND="" D 10 . I '$D(FDA(811.902,IND,12)) Q 11 .;If the EFFECTIVE PERIOD exists don't do anything. 12 . I $D(FDA(811.902,IND,9)) Q 13 . S FDA(811.902,IND,9)=FDA(811.902,IND,12) 14 . K FDA(811.902,IND,12) 15 Q 16 ; 17 ;================================================== 18 COMPARE(X) ;Compare beginning and ending dates, give a warning if 19 ;Ending Date comes before Beginning Date. Called by ADATE xref in 20 ;definitions and terms. 21 ;Do not execute as part of exchange. 22 I $G(PXRMEXCH) Q 23 N BDT,EDT 24 S BDT=$S(X(1)'="":$$CTFMD^PXRMDATE(X(1)),1:0) 25 S EDT=X(2) 26 I EDT="" S EDT="T" 27 S EDT=$$CTFMD^PXRMDATE(EDT) 28 ;If EDT does not contain a time set it to the end of the day. 29 I EDT'["." S EDT=EDT_".235959" 30 I EDT<BDT D 31 . S BDT=$S(X(1)'="":X(1),1:"") 32 . S EDT=$S(X(2)'="":X(2),1:"T@2400") 33 . S TEXT="Warning the ending date ("_EDT_") is before the beginning date ("_BDT_")" 34 . D EN^DDIOL(TEXT) 35 Q 36 ; 37 ;================================================== 38 COTN(EFP) ;Convert an Effective Period to the new date/time format. 39 ;Possible effective periods are ND, NM, or NY where N is an integer. 40 S EFP=$$UP^XLFSTR(EFP) 41 I (EFP?1N.N1"D")!(EFP?1N.N1"M")!(EFP?1N.N1"Y") D 42 . S NUM=+EFP 43 . S EFP=$S(NUM=0:"T",1:"T-"_EFP) 44 Q EFP 45 ; 46 ;================================================== 47 CTFMD(DATE) ;Convert DATE which may be in any of the FileMan acceptable 48 ;forms as well as T-NY to a FileMan date. Also understands LAD for 49 ;Last Admission Date. 50 N %DT,ND,X,Y 51 ;Already a FileMan date? 52 S ND=+DATE 53 I (ND'<1000000),(ND'>9991231) Q DATE 54 ;Check for a date FileMan understands. 55 S X=DATE,%DT="ST" 56 D ^%DT 57 ;If it is not a FileMan date check for a symbolic date. 58 I Y=-1 S Y=$$SYMDATE(DATE) 59 ;If it is not a date that is understood by SYMDATE return -1 60 I Y=-1 Q -1 61 I $G(PXRMDATE)'="",$$ISVSYMD(DATE) D 62 . N DIFFS 63 . S DIFFS=-$$FMDIFF^XLFDT(DT,PXRMDATE,2) 64 . S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS) 65 I DATE["LAD" D 66 . I $G(PXRMLAD)="" S Y=0 67 . E D 68 .. N DIFFS 69 .. S DIFFS=-$$FMDIFF^XLFDT(DT,$G(PXRMLAD),2) 70 .. S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS) 71 Q Y 72 ; 73 ;================================================= 74 DCHECK(DATE) ;Trap for special characters before calling CTFMD^PXRMDATE. 75 ;Used in DIR("PRE") for date inputs. 76 I $D(DTOUT) Q DATE 77 I DATE="" Q DATE 78 I DATE["^" Q DATE 79 I DATE["?" Q DATE 80 Q $$CTFMD^PXRMDATE(DATE) 81 ; 82 ;================================================== 83 DUE(DEFARR,RESDATE,FREQ,DUE,DUEDATE,FIEVAL) ;Compute the due date. 84 ;This is the date of the resolution finding + the reminder frequency. 85 ;Subtract the due in advance time to see if the reminder should be 86 ;marked as due soon. 87 ; 88 N DATE,DIAT,DIATOK,LDATE,PXRMITEM,TDDUE,TODAY 89 S PXRMITEM=DEFARR("IEN") 90 ;If the final frequency is 0Y then the reminder is not due. 91 I FREQ="0Y" S DUE=0,DUEDATE="" Q 92 ; 93 S DUEDATE="" 94 ;Check for custom date due. 95 I DEFARR(45)'="" S DUEDATE=$$CDUEDATE^PXRMCDUE(.DEFARR,.FIEVAL) 96 I DUEDATE'="",DUEDATE'=-1 G SETDUE 97 ; 98 ;No custom date due, do regular date calculation. 99 I (FREQ="")!(FREQ=-1) D Q 100 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFREQ")="No reminder frequency - cannot compute due date!" 101 . S (DUE,DUEDATE)="CNBD" 102 ; 103 S LDATE=$S(RESDATE["X":0,1:+RESDATE) 104 I LDATE=0 S (DUE,DUEDATE)="DUE NOW" Q 105 S DATE=$$FULLDATE(LDATE),DUEDATE=$$NEWDATE(DATE,FREQ) 106 ; 107 SETDUE ;If the due date is less than or equal to today's date the reminder 108 ;is due. 109 S TODAY=$$NOW^PXRMDATE 110 I +DUEDATE'>TODAY S DUE="DUE NOW" Q 111 ; 112 S DIAT="-"_$P(DEFARR(0),U,4) 113 I DIAT="-" D 114 . S DIATOK=0 115 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","DIAT")="Warning no do in advance time" 116 E S DIATOK=1 117 ; 118 S TDDUE=$S(DIATOK=1:$$NEWDATE(DUEDATE,DIAT),1:DUEDATE) 119 S DUE=$S(TDDUE'>TODAY:"DUE SOON",1:"RESOLVED") 120 Q 121 ; 122 ;================================================== 123 DURATION(START,STOP) ;Return the number days between the Start Date and 124 ;Stop Date. 125 I +START=0 Q 0 126 N PXRMNOW 127 S PXRMNOW=$$NOW^PXRMDATE 128 I START>PXRMNOW Q 0 129 I (STOP="")!(STOP>PXRMNOW) S STOP=PXRMNOW 130 Q $$FMDIFF^XLFDT(STOP,START) 131 ; 132 ;================================================== 133 EDATE(DATE) ;Check for an historical (event) date, format as appropriate. 134 Q $$FMTE^XLFDT(DATE,"5DZ") 135 ; 136 ;================================================== 137 FULLDATE(DATE) ;See if DATE is a full date, i.e., it has a month and 138 ;a day along with a year. If the month is missing assume Jan. If the 139 ;day is missing assume the first. Issue a warning so the user knows 140 ;what happened. DATE should be in Fileman format. 141 N DAY,MISSING,MONTH,TDATE,YEAR 142 S TDATE=DATE 143 S MISSING=0 144 S DAY=$E(DATE,6,7) 145 S MONTH=$E(DATE,4,5) 146 S YEAR=$E(DATE,1,3) 147 I +DAY=0 D 148 . S DAY=1 149 . S MISSING=1 150 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO DAY")="Encounter date missing the day, using the first for the date due calculation." 151 I +MONTH=0 D 152 . S MONTH=1 153 . S MISSING=1 154 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO MONTH")="Encounter date missing the month, using January for the date due calculation." 155 I MISSING D 156 . S TDATE=(YEAR*1E4)+(MONTH*1E2)+DAY 157 . I DATE["E" S TDATE=TDATE_"E" 158 Q TDATE 159 ; 160 ;================================================== 161 FRQINDAY(FREQ) ;Given a frequency in the form ND, NM, or NY where N is a 162 ;number and D stands for days, M for months, and Y for years return 163 ;the value in days. 164 I FREQ="" Q "" 165 N CODE,LEN,MULT,NUM 166 S LEN=$L(FREQ) 167 S NUM=$E(FREQ,1,LEN-1) 168 S CODE=$E(FREQ,LEN,LEN) 169 S MULT=1.0 170 I CODE="M" S MULT=30.42 171 I CODE="Y" S MULT=365.25 172 Q +(MULT*NUM) 173 ; 174 ;================================================== 175 ISVSYMD(DATE) ;Return true if DATE is a valid symbolic date. 176 N P1,P1OK,P2,P2OK,OP,PAT 177 S DATE=$P(DATE,"@",1) 178 S OP=$S(DATE["+":"+",1:"-") 179 S P1=$P(DATE,OP,1),P1OK=0 180 F PAT="T","TODAY","N","NOW" I P1=PAT S P1OK=1 Q:P1OK 181 I PAT=DATE Q 1 182 S P2=$P(DATE,OP,2),P2OK=0 183 F PAT="1N.N","1N.N1""D""","1N.N1""M""","1N.N1""Y""" I P2?@PAT S P2OK=1 Q:P2OK 184 Q P1OK&P2OK 185 ; 186 ;================================================== 187 NEWDATE(FMDATE,OFFSET) ;Given a date in VA Fileman format (FMDATE) and an 188 ;offset of the form NY, NM, ND where N is a number and Y stands for 189 ;years, M for months, and D for days return the new date in VA Fileman 190 ;format. 191 I FMDATE=0 Q 0 192 N LEN,NEWDATE,NUM,UNIT 193 S LEN=$L(OFFSET) 194 S NUM=+$E(OFFSET,1,LEN-1) 195 S UNIT=$E(OFFSET,LEN) 196 I UNIT="D" G DAY 197 I UNIT="M" G MONTH 198 I UNIT="Y" G YEAR 199 ;Unknown unit just return the original date 200 Q FMDATE 201 DAY ; 202 S NEWDATE=+$$FMADD^XLFDT(FMDATE,NUM) 203 Q NEWDATE 204 MONTH ; 205 ;Convert the months to days and then add the days using the DAY code. 206 ;Multiply the number of months by the average number of days in a month. 207 N INT,FRAC 208 S NUM=30.42*NUM 209 ;Round the number of days, FMADD^XLFDT has problems with non-integer 210 ;days. 211 S INT=+$P(NUM,".",1) 212 S FRAC=NUM-INT 213 I FRAC<0.5 S NUM=INT 214 E S NUM=INT+1 215 G DAY 216 Q 217 YEAR ; 218 Q FMDATE+(10000*NUM) 219 ; 220 ;================================================== 221 NOW() ;If the reminder global PXRMDATE is defined return it, otherwise 222 ;return the current date and time. 223 Q $S(+$G(PXRMDATE)>0:PXRMDATE,1:$$NOW^XLFDT) 224 ; 225 ;================================================== 226 SYMDATE(DATE) ;Convert a symbolic date into a FileMan date. 227 N %DT,OPER,PFSTACK,SYM,TIME,X,Y 228 S TIME=$P(DATE,"@",2),DATE=$P(DATE,"@",1) 229 S X=$S(DATE="LAD":$G(PXRMLAD),1:"") 230 I X="" D 231 . S OPER="+-" 232 . D POSTFIX^PXRMSTAC(DATE,OPER,.PFSTACK) 233 I PFSTACK(0)=3 D 234 . S SYM=PFSTACK(1) 235 . S SYM=$S(SYM="LAD":"T",SYM="N":"N",SYM="NOW":"N",SYM="T":"T",SYM="TODAY":"T",1:"") 236 . I SYM="" S Y=-1 Q 237 .;FileMan only handles D, W, or M so convert Y to months. 238 . I PFSTACK(2)["Y" S PFSTACK(2)=+PFSTACK(2)*12_"M" 239 . S X=SYM_PFSTACK(3)_PFSTACK(2) 240 I PFSTACK(0)=1 S X=PFSTACK(1) 241 I TIME'="" S X=X_"@"_TIME 242 S %DT="ST" 243 D ^%DT 244 Q Y 245 ; 246 ;================================================== 247 VDATE(VIEN) ;Given a visit ien return the visit date. 248 N DATE 249 I +VIEN>0 S DATE=$P($G(^AUPNVSIT(VIEN,0)),U,1) 250 E S DATE=0 251 I $L(DATE)=0 S DATE=0 252 ;Check for historical encounter. 253 I $$ISHIST^PXRMVSIT(VIEN) S DATE=DATE_"E" 254 Q DATE 255 ; 1 PXRMDATE ; SLC/PKR - Clinical Reminders date utilities. ;06/20/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;================================================== 5 CEFD(FDA) ;Called by the Exchange Utility only if the input packed 6 ;reminder was packed under v1.5 Move Effective Date to Beginning Date. 7 N IND 8 S IND="" 9 F S IND=$O(FDA(811.902,IND)) Q:IND="" D 10 . I '$D(FDA(811.902,IND,12)) Q 11 .;If the EFFECTIVE PERIOD exists don't do anything. 12 . I $D(FDA(811.902,IND,9)) Q 13 . S FDA(811.902,IND,9)=FDA(811.902,IND,12) 14 . K FDA(811.902,IND,12) 15 Q 16 ; 17 ;================================================== 18 COMPARE(X) ;Compare beginning and ending dates, give a warning if 19 ;Ending Date comes before Beginning Date. Called by ADATE xref in 20 ;definitions and terms. 21 ;Do not execute as part of exchange. 22 I $G(PXRMEXCH) Q 23 N BDT,EDT 24 S BDT=$S(X(1)'="":$$CTFMD^PXRMDATE(X(1)),1:0) 25 S EDT=X(2) 26 I EDT="" S EDT="T" 27 S EDT=$$CTFMD^PXRMDATE(EDT) 28 ;If EDT does not contain a time set it to the end of the day. 29 I EDT'["." S EDT=EDT_".235959" 30 I EDT<BDT D 31 . S BDT=$S(X(1)'="":X(1),1:"") 32 . S EDT=$S(X(2)'="":X(2),1:"T@2400") 33 . S TEXT="Warning the ending date ("_EDT_") is before the beginning date ("_BDT_")" 34 . D EN^DDIOL(TEXT) 35 Q 36 ; 37 ;================================================== 38 COTN(EFP) ;Convert an Effective Period to the new date/time format. 39 ;Possible effective periods are ND, NM, or NY where N is an integer. 40 S EFP=$$UP^XLFSTR(EFP) 41 I (EFP?1N.N1"D")!(EFP?1N.N1"M")!(EFP?1N.N1"Y") D 42 . S NUM=+EFP 43 . S EFP=$S(NUM=0:"T",1:"T-"_EFP) 44 Q EFP 45 ; 46 ;================================================== 47 CTFMD(DATE) ;Convert DATE which may be in any of the FileMan acceptable 48 ;forms as well as T-NY to a FileMan date. Also understands LAD for 49 ;Last Admission Date. 50 N %DT,X,Y 51 ;Check for a date FileMan understands. 52 S X=DATE,%DT="ST" 53 D ^%DT 54 ;If it is not a FileMan date check for a symbolic date. 55 I Y=-1 S Y=$$SYMDATE(DATE) 56 ;If it is not a date that is understood by SYMDATE return -1 57 I Y=-1 Q -1 58 I $G(PXRMDATE)'="",$$ISVSYMD(DATE) D 59 . N DIFFS 60 . S DIFFS=-$$FMDIFF^XLFDT(DT,PXRMDATE,2) 61 . S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS) 62 I DATE["LAD" D 63 . I $G(PXRMLAD)="" S Y=0 64 . E D 65 .. N DIFFS 66 .. S DIFFS=-$$FMDIFF^XLFDT(DT,$G(PXRMLAD),2) 67 .. S Y=$$FMADD^XLFDT(Y,0,0,0,DIFFS) 68 Q Y 69 ; 70 ;================================================= 71 DCHECK(DATE) ;Trap for special characters before calling CTFMD^PXRMDATE. 72 ;Used in DIR("PRE") for date inputs. 73 I $D(DTOUT) Q DATE 74 I DATE="" Q DATE 75 I DATE["^" Q DATE 76 I DATE["?" Q DATE 77 Q $$CTFMD^PXRMDATE(DATE) 78 ; 79 ;================================================== 80 DUE(DEFARR,RESDATE,FREQ,DUE,DUEDATE,FIEVAL) ;Compute the due date. 81 ;This is the date of the resolution finding + the reminder frequency. 82 ;Subtract the due in advance time to see if the reminder should be 83 ;marked as due soon. 84 ; 85 N DATE,DIAT,DIATOK,LDATE,PXRMITEM,TDDUE,TODAY 86 S PXRMITEM=DEFARR("IEN") 87 ;If the final frequency is 0Y then the reminder is not due. 88 I FREQ="0Y" S DUE=0,DUEDATE="" Q 89 ; 90 S DUEDATE="" 91 ;Check for custom date due. 92 I DEFARR(45)'="" S DUEDATE=$$CDUEDATE^PXRMCDUE(.DEFARR,.FIEVAL) 93 I DUEDATE'="",DUEDATE'=-1 G SETDUE 94 ; 95 ;No custom date due, do regular date calculation. 96 I (FREQ="")!(FREQ=-1) D Q 97 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFREQ")="No reminder frequency - cannot compute due date!" 98 . S (DUE,DUEDATE)="CNBD" 99 ; 100 S LDATE=$S(RESDATE["X":0,1:+RESDATE) 101 I LDATE=0 S (DUE,DUEDATE)="DUE NOW" Q 102 S DATE=$$FULLDATE(LDATE),DUEDATE=$$NEWDATE(DATE,FREQ) 103 ; 104 SETDUE ;If the due date is less than or equal to today's date the reminder 105 ;is due. 106 S TODAY=$$NOW^PXRMDATE 107 I +DUEDATE'>TODAY S DUE="DUE NOW" Q 108 ; 109 S DIAT="-"_$P(DEFARR(0),U,4) 110 I DIAT="-" D 111 . S DIATOK=0 112 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","DIAT")="Warning no do in advance time" 113 E S DIATOK=1 114 ; 115 S TDDUE=$S(DIATOK=1:$$NEWDATE(DUEDATE,DIAT),1:DUEDATE) 116 S DUE=$S(TDDUE'>TODAY:"DUE SOON",1:"RESOLVED") 117 Q 118 ; 119 ;================================================== 120 DURATION(START,STOP) ;Return the number days between the Start Date and 121 ;Stop Date. 122 I +START=0 Q 0 123 N PXRMNOW 124 S PXRMNOW=$$NOW^PXRMDATE 125 I START>PXRMNOW Q 0 126 I (STOP="")!(STOP>PXRMNOW) S STOP=PXRMNOW 127 Q $$FMDIFF^XLFDT(STOP,START) 128 ; 129 ;================================================== 130 EDATE(DATE) ;Check for an historical (event) date, format as appropriate. 131 Q $$FMTE^XLFDT(DATE,"5DZ") 132 ; 133 ;================================================== 134 FULLDATE(DATE) ;See if DATE is a full date, i.e., it has a month and 135 ;a day along with a year. If the month is missing assume Jan. If the 136 ;day is missing assume the first. Issue a warning so the user knows 137 ;what happened. DATE should be in Fileman format. 138 N DAY,MISSING,MONTH,TDATE,YEAR 139 S TDATE=DATE 140 S MISSING=0 141 S DAY=$E(DATE,6,7) 142 S MONTH=$E(DATE,4,5) 143 S YEAR=$E(DATE,1,3) 144 I +DAY=0 D 145 . S DAY=1 146 . S MISSING=1 147 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO DAY")="Encounter date missing the day, using the first for the date due calculation." 148 I +MONTH=0 D 149 . S MONTH=1 150 . S MISSING=1 151 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","NO MONTH")="Encounter date missing the month, using January for the date due calculation." 152 I MISSING D 153 . S TDATE=(YEAR*1E4)+(MONTH*1E2)+DAY 154 . I DATE["E" S TDATE=TDATE_"E" 155 Q TDATE 156 ; 157 ;================================================== 158 FRQINDAY(FREQ) ;Given a frequency in the form ND, NM, or NY where N is a 159 ;number and D stands for days, M for months, and Y for years return 160 ;the value in days. 161 I FREQ="" Q "" 162 N CODE,LEN,MULT,NUM 163 S LEN=$L(FREQ) 164 S NUM=$E(FREQ,1,LEN-1) 165 S CODE=$E(FREQ,LEN,LEN) 166 S MULT=1.0 167 I CODE="M" S MULT=30.42 168 I CODE="Y" S MULT=365.25 169 Q +(MULT*NUM) 170 ; 171 ;================================================== 172 ISVSYMD(DATE) ;Return true if DATE is a valid symbolic date. 173 N P1,P1OK,P2,P2OK,OP,PAT 174 S DATE=$P(DATE,"@",1) 175 S OP=$S(DATE["+":"+",1:"-") 176 S P1=$P(DATE,OP,1),P1OK=0 177 F PAT="T","TODAY","N","NOW" I P1=PAT S P1OK=1 Q:P1OK 178 I PAT=DATE Q 1 179 S P2=$P(DATE,OP,2),P2OK=0 180 F PAT="1N.N","1N.N1""D""","1N.N1""M""","1N.N1""Y""" I P2?@PAT S P2OK=1 Q:P2OK 181 Q P1OK&P2OK 182 ; 183 ;================================================== 184 NEWDATE(FMDATE,OFFSET) ;Given a date in VA Fileman format (FMDATE) and an 185 ;offset of the form NY, NM, ND where N is a number and Y stands for 186 ;years, M for months, and D for days return the new date in VA Fileman 187 ;format. 188 I FMDATE=0 Q 0 189 N LEN,NEWDATE,NUM,UNIT 190 S LEN=$L(OFFSET) 191 S NUM=+$E(OFFSET,1,LEN-1) 192 S UNIT=$E(OFFSET,LEN) 193 I UNIT="D" G DAY 194 I UNIT="M" G MONTH 195 I UNIT="Y" G YEAR 196 ;Unknown unit just return the original date 197 Q FMDATE 198 DAY ; 199 S NEWDATE=+$$FMADD^XLFDT(FMDATE,NUM) 200 Q NEWDATE 201 MONTH ; 202 ;Convert the months to days and then add the days using the DAY code. 203 ;Multiply the number of months by the average number of days in a month. 204 N INT,FRAC 205 S NUM=30.42*NUM 206 ;Round the number of days, FMADD^XLFDT has problems with non-integer 207 ;days. 208 S INT=+$P(NUM,".",1) 209 S FRAC=NUM-INT 210 I FRAC<0.5 S NUM=INT 211 E S NUM=INT+1 212 G DAY 213 Q 214 YEAR ; 215 Q FMDATE+(10000*NUM) 216 ; 217 ;================================================== 218 NOW() ;If the reminder global PXRMDATE is defined return it, otherwise 219 ;return the current date and time. 220 Q $S(+$G(PXRMDATE)>0:PXRMDATE,1:$$NOW^XLFDT) 221 ; 222 ;================================================== 223 SYMDATE(DATE) ;Convert a symbolic date into a FileMan date. 224 N %DT,OPER,PFSTACK,SYM,TIME,X,Y 225 S TIME=$P(DATE,"@",2),DATE=$P(DATE,"@",1) 226 S X=$S(DATE="LAD":$G(PXRMLAD),1:"") 227 I X="" D 228 . S OPER="+-" 229 . D POSTFIX^PXRMSTAC(DATE,OPER,.PFSTACK) 230 I PFSTACK(0)=3 D 231 . S SYM=PFSTACK(1) 232 . S SYM=$S(SYM="LAD":"T",SYM="N":"N",SYM="NOW":"N",SYM="T":"T",SYM="TODAY":"T",1:"") 233 . I SYM="" S Y=-1 Q 234 .;FileMan only handles D, W, or M so convert Y to months. 235 . I PFSTACK(2)["Y" S PFSTACK(2)=+PFSTACK(2)*12_"M" 236 . S X=SYM_PFSTACK(3)_PFSTACK(2) 237 I PFSTACK(0)=1 S X=PFSTACK(1) 238 I TIME'="" S X=X_"@"_TIME 239 S %DT="ST" 240 D ^%DT 241 Q Y 242 ; 243 ;================================================== 244 VDATE(VIEN) ;Given a visit ien return the visit date. 245 N DATE 246 I +VIEN>0 S DATE=$P($G(^AUPNVSIT(VIEN,0)),U,1) 247 E S DATE=0 248 I $L(DATE)=0 S DATE=0 249 ;Check for historical encounter. 250 I $$ISHIST^PXRMVSIT(VIEN) S DATE=DATE_"E" 251 Q DATE 252 ;
Note:
See TracChangeset
for help on using the changeset viewer.
