Changeset 1438 for qrda/C0Q/trunk/p/C0QUTIL.m
- Timestamp:
- May 25, 2012, 5:55:11 PM (14 years ago)
- File:
-
- 1 edited
-
qrda/C0Q/trunk/p/C0QUTIL.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
qrda/C0Q/trunk/p/C0QUTIL.m
r1364 r1438 1 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm2 ;;1.0;MU PACKAGE;;;Build 27 3 ;4 ;2011 Licensed under the terms of the GNU General Public License5 ;See attached copy of the License.6 ;7 ;This program is free software; you can redistribute it and/or modify8 ;it under the terms of the GNU General Public License as published by9 ;the Free Software Foundation; either version 2 of the License, or10 ;(at your option) any later version.11 ;12 ;This program is distributed in the hope that it will be useful,13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ;GNU General Public License for more details.16 ;17 ;You should have received a copy of the GNU General Public License along18 ;with this program; if not, write to the Free Software Foundation, Inc.,19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.20 ;21 AGE(DFN) ; return current age in years and months22 ;23 Q:'$G(DFN) ;quit if no there is no patient24 N DOB S DOB=$P(^DPT(+DFN,0),U,3) ;date of birth25 N YRS26 N DOD S DOD=+$G(^DPT(9,.35)) ;check for date of death27 I 'DOD D28 . N CDTE S CDTE=DT ;current date29 . S YRS=$E(CDTE,1,3)-$E(DOB,1,3)-($E(CDTE,4,7)<$E(DOB,4,7))30 E D31 . S YRS=$E(DOD,1,3)-$E(DOB,1,3)-($E(DOD,4,7)<$E(DOB,4,7))32 ;33 ;Come back here and fix MONTHS and DAYS34 ;N CM S CM=+$E(DT,4,5) ;current month35 ;N CD S CD=+$E(DT,6,7) ;current day36 ;N BM S BM=+$E(DOB,4,5) ;birth month37 ;N BD S BD=+$E(DOB,6,7) ;birth day38 ;39 ;N DAYS S DAYS=""40 ;41 Q YRS ;_"y" gpl ..just want the number42 ;43 ;44 DTDIFF(ZD1,ZT1,ZD2,ZT2,SHOW) ; extrinsic which returns the number of minutes45 ; between 2 dates. ZD1 and ZD2 are fileman dates46 ; ZT1 AND ZT2 are valid times (military time) ie 20:1047 ; IF SHOW=1 DEBUGGING INTERMEDIATE VALUES WILL BE DISPLAYED48 I '$D(SHOW) S SHOW=049 N GT1,GT2,GDT1,GDT250 I ZT1[":" D ;51 . S GT1=($P(ZT1,":",1)*3600)+($P(ZT1,":",2)*60) ; SECONDS52 . S GT2=($P(ZT2,":",1)*3600)+($P(ZT2,":",2)*60) ; SECONDS53 E D ;54 . S GT1=($E(ZT1,1,2)*3600)+($E(ZT1,3,4)*60)55 . S GT2=($E(ZT2,1,2)*3600)+($E(ZT2,3,4)*60)56 ;W:SHOW !,"SECONDS: ",GT1," ",GT257 ;S %=GT1 D S^%DTC ; FILEMAN TIME58 ;S GDT1=ZD1_% ; FILEMAN DATE AND TIME59 ;S %=GT2 D S^%DTC ; FILEMAN TIME60 ;S GDT2=ZD2_% ; FILEMAN DATE AND TIME61 S GDT1=ZD1_"."_ZT162 S GDT2=ZD2_"."_ZT263 W:SHOW !,"FILEMAN: ",GDT1," ",GDT264 N ZH1,ZH265 S ZH1=$$FMTH^XLFDT(GDT1) ; $H FORMAT66 S ZH2=$$FMTH^XLFDT(GDT2) ; $H FORMAT67 W:SHOW !,"$H: ",ZH1," ",ZH268 N ZSECS,ZMIN69 S ZSECS=$$HDIFF^XLFDT(ZH1,ZH2,2) ; DIFFERENCE IN $H70 W:SHOW !,"DIFF: ",ZSECS71 S ZMIN=ZSECS/60 ; DIFFERENCE IN MINUTES72 W:SHOW !,"MIN: ",ZMIN73 Q ZMIN74 ;75 DT(X) ; -- Returns FM date for X76 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT77 Q Y78 ;79 END ;end of C0QUTIL1 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 ; 4 ;2011 Licensed under the terms of the GNU General Public License 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 AGE(DFN) ; return current age in years and months 22 ; 23 Q:'$G(DFN) ;quit if no there is no patient 24 N DOB S DOB=$P(^DPT(+DFN,0),U,3) ;date of birth 25 N YRS 26 N DOD S DOD=+$G(^DPT(9,.35)) ;check for date of death 27 I 'DOD D 28 . N CDTE S CDTE=DT ;current date 29 . S YRS=$E(CDTE,1,3)-$E(DOB,1,3)-($E(CDTE,4,7)<$E(DOB,4,7)) 30 E D 31 . S YRS=$E(DOD,1,3)-$E(DOB,1,3)-($E(DOD,4,7)<$E(DOB,4,7)) 32 ; 33 ;Come back here and fix MONTHS and DAYS 34 ;N CM S CM=+$E(DT,4,5) ;current month 35 ;N CD S CD=+$E(DT,6,7) ;current day 36 ;N BM S BM=+$E(DOB,4,5) ;birth month 37 ;N BD S BD=+$E(DOB,6,7) ;birth day 38 ; 39 ;N DAYS S DAYS="" 40 ; 41 Q YRS ;_"y" gpl ..just want the number 42 ; 43 ; 44 DTDIFF(ZD1,ZT1,ZD2,ZT2,SHOW) ; extrinsic which returns the number of minutes 45 ; between 2 dates. ZD1 and ZD2 are fileman dates 46 ; ZT1 AND ZT2 are valid times (military time) ie 20:10 47 ; IF SHOW=1 DEBUGGING INTERMEDIATE VALUES WILL BE DISPLAYED 48 I '$D(SHOW) S SHOW=0 49 N GT1,GT2,GDT1,GDT2 50 I ZT1[":" D ; 51 . S GT1=($P(ZT1,":",1)*3600)+($P(ZT1,":",2)*60) ; SECONDS 52 . S GT2=($P(ZT2,":",1)*3600)+($P(ZT2,":",2)*60) ; SECONDS 53 E D ; 54 . S GT1=($E(ZT1,1,2)*3600)+($E(ZT1,3,4)*60) 55 . S GT2=($E(ZT2,1,2)*3600)+($E(ZT2,3,4)*60) 56 ;W:SHOW !,"SECONDS: ",GT1," ",GT2 57 ;S %=GT1 D S^%DTC ; FILEMAN TIME 58 ;S GDT1=ZD1_% ; FILEMAN DATE AND TIME 59 ;S %=GT2 D S^%DTC ; FILEMAN TIME 60 ;S GDT2=ZD2_% ; FILEMAN DATE AND TIME 61 S GDT1=ZD1_"."_ZT1 62 S GDT2=ZD2_"."_ZT2 63 W:SHOW !,"FILEMAN: ",GDT1," ",GDT2 64 N ZH1,ZH2 65 S ZH1=$$FMTH^XLFDT(GDT1) ; $H FORMAT 66 S ZH2=$$FMTH^XLFDT(GDT2) ; $H FORMAT 67 W:SHOW !,"$H: ",ZH1," ",ZH2 68 N ZSECS,ZMIN 69 S ZSECS=$$HDIFF^XLFDT(ZH1,ZH2,2) ; DIFFERENCE IN $H 70 W:SHOW !,"DIFF: ",ZSECS 71 S ZMIN=ZSECS/60 ; DIFFERENCE IN MINUTES 72 W:SHOW !,"MIN: ",ZMIN 73 Q ZMIN 74 ; 75 DT(X) ; -- Returns FM date for X 76 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT 77 Q Y 78 ; 79 END ;end of C0QUTIL
Note:
See TracChangeset
for help on using the changeset viewer.
