- Timestamp:
- Feb 19, 2012, 11:09:05 PM (14 years ago)
- Location:
- qrda/C0Q/trunk
- Files:
-
- 3 added
- 15 edited
-
kids/C0Q_1_0_1_T16.KID (added)
-
p/C0QERTIM.m (modified) (1 diff)
-
p/C0QGMRAD.m (modified) (1 diff)
-
p/C0QGMTSA.m (modified) (1 diff)
-
p/C0QGMTSG.m (modified) (1 diff)
-
p/C0QHF.m (modified) (1 diff)
-
p/C0QIMMUN.m (modified) (1 diff)
-
p/C0QINIT.m (modified) (1 diff)
-
p/C0QMAIN.m (modified) (1 diff)
-
p/C0QMU12.m (modified) (5 diffs)
-
p/C0QNOTES.m (modified) (1 diff)
-
p/C0QPQRI.m (modified) (1 diff)
-
p/C0QPRML.m (modified) (1 diff)
-
p/C0QSET.m (modified) (1 diff)
-
p/C0QUPDT.m (modified) (1 diff)
-
p/C0QUTIL.m (modified) (1 diff)
-
rdf (added)
-
rdf/quality1.rdf (added)
Legend:
- Unmodified
- Added
- Removed
-
qrda/C0Q/trunk/p/C0QERTIM.m
r1361 r1364 1 1 C0QERTIM ; Time from admission to leaving a hospital location ; 2 ;;0.1;C0Q;;;Build 2 62 ;;0.1;C0Q;;;Build 27 3 3 EN ;Get Location 4 4 S DIC=42,DIC(0)="AEMQ" D ^DIC I Y<1 G EXIT -
qrda/C0Q/trunk/p/C0QGMRAD.m
r1361 r1364 1 1 C0QGMRAD ;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;1/15/98 13:47 2 ;;4.0;Adverse Reaction Tracking;**2,10**;Mar 29, 1996;Build 2 62 ;;4.0;Adverse Reaction Tracking;**2,10**;Mar 29, 1996;Build 27 3 3 EN1 ; ENTRY TO GATHER PATIENT A/AR DATA 4 4 ;INPUT VARIABLES: -
qrda/C0Q/trunk/p/C0QGMTSA.m
r1361 r1364 1 1 C0QGMTSA ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002 2 ;;2.7;Health Summary;**28,49**;Oct 20, 1995;Build 2 62 ;;2.7;Health Summary;**28,49**;Oct 20, 1995;Build 27 3 3 ; 4 4 ; External References -
qrda/C0Q/trunk/p/C0QGMTSG.m
r1361 r1364 1 1 C0QGMTSG ; SLC/DLT,KER - Allergies ; 01/06/2003 2 ;;2.7;Health Summary;**9,28,49,58**;Oct 20, 1995;Build 2 62 ;;2.7;Health Summary;**9,28,49,58**;Oct 20, 1995;Build 27 3 3 ; 4 4 ; External References -
qrda/C0Q/trunk/p/C0QHF.m
r1361 r1364 1 1 C0QHF ; GPL - Health Factor Utility Routines ;9/02/11 17:05 2 ;;0.1;C0Q;nopatch;noreleasedate;Build 2 62 ;;0.1;C0Q;nopatch;noreleasedate;Build 27 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QIMMUN.m
r1361 r1364 1 1 C0QIMMUN ;Prep Immunization Order data for HL7 Message creation ; 2 ;;0.1;C0Q;nopatch;noreleasedate;Build 2 62 ;;0.1;C0Q;nopatch;noreleasedate;Build 27 3 3 ; ^XTMP("C0QIMMUN",0)=purge date^create date 4 4 ; ^XTMP("C0QIMMUN",order_date,order#,item_name)=item_value -
qrda/C0Q/trunk/p/C0QINIT.m
r1361 r1364 1 C0QINIT ; GPL - Quality Reporting Initialization Routines ;12/01/11 17:052 ;;0.1;C0Q;nopatch;noreleasedate;Build 26 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU4 ;General Public License See attached copy of the License.5 ;6 ;This program is free software; you can redistribute it and/or modify7 ;it under the terms of the GNU General Public License as published by8 ;the Free Software Foundation; either version 2 of the License, or9 ;(at your option) any later version.10 ;11 ;This program is distributed in the hope that it will be useful,12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the14 ;GNU General Public License for more details.15 ;16 ;You should have received a copy of the GNU General Public License along17 ;with this program; if not, write to the Free Software Foundation, Inc.,18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.19 ;20 Q21 ;22 C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE23 C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE24 C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE25 C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE26 C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE27 RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE28 RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE29 C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;30 ;31 COPYQ ; INTERACTIVE COPY OF A QUALITY MEASURE32 N FN33 S FN=$$C0QQFN34 S DIC=FN,DIC(0)="AEMQ" D ^DIC35 I Y<1 Q ; EXIT36 S C0QIEN=$P(Y,U)37 ;N G,ZWP38 D GETS^DIQ(FN,C0QIEN,"**","EI","G")39 M ZWP=G(FN,C0QIEN_",",.61)40 ; GET READY TO CREATE THE NEW COPY41 ; FIRST FIND OUT THE NEW NAME42 N QNAME43 S QNAME=G(FN,C0QIEN_",",.01,"E")44 S DIR(0)="F^3:240"45 S DIR("A")="New Measure Name"46 S DIR("B")=QNAME47 D ^DIR48 I Y="^" Q ;49 N QNEW50 S QNEW=Y51 K C0QFDA52 N ZI S ZI=""53 F S ZI=$O(G(FN,C0QIEN_",",ZI)) Q:ZI="" D ; FOR EACH FIELD54 . I ZI=.01 D Q ; THE NEW NAME55 . . S C0QFDA(FN,"+1,",.01)=QNEW ; NEW MEASURE NAME56 . I ZI=3.1 Q ; SKIP THE COMPUTED FIELD57 . S C0QFDA(FN,"+1,",ZI)=G(FN,C0QIEN_",",ZI,"I")58 D UPDIE ; CREATE THE NEW RECORD59 S DIE=$$C0QQFN ; GET READY TO EDIT IT60 D EN^DIB ; EDIT THE NEW RECORD61 Q62 ;63 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS64 K ZERR65 D CLEAN^DILF66 ZWR C0QFDA67 D UPDATE^DIE("","C0QFDA","","ZERR")68 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST,69 ; INVOKE THE ERROR TRAP IF TASKED70 K C0QFDA71 Q72 ;1 C0QINIT ; GPL - Quality Reporting Initialization Routines ;12/01/11 17:05 2 ;;0.1;C0Q;nopatch;noreleasedate;Build 27 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 Q 21 ; 22 C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE 23 C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE 24 C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE 25 C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE 26 C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE 27 RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE 28 RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE 29 C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ; 30 ; 31 COPYQ ; INTERACTIVE COPY OF A QUALITY MEASURE 32 N FN 33 S FN=$$C0QQFN 34 S DIC=FN,DIC(0)="AEMQ" D ^DIC 35 I Y<1 Q ; EXIT 36 S C0QIEN=$P(Y,U) 37 ;N G,ZWP 38 D GETS^DIQ(FN,C0QIEN,"**","EI","G") 39 M ZWP=G(FN,C0QIEN_",",.61) 40 ; GET READY TO CREATE THE NEW COPY 41 ; FIRST FIND OUT THE NEW NAME 42 N QNAME 43 S QNAME=G(FN,C0QIEN_",",.01,"E") 44 S DIR(0)="F^3:240" 45 S DIR("A")="New Measure Name" 46 S DIR("B")=QNAME 47 D ^DIR 48 I Y="^" Q ; 49 N QNEW 50 S QNEW=Y 51 K C0QFDA 52 N ZI S ZI="" 53 F S ZI=$O(G(FN,C0QIEN_",",ZI)) Q:ZI="" D ; FOR EACH FIELD 54 . I ZI=.01 D Q ; THE NEW NAME 55 . . S C0QFDA(FN,"+1,",.01)=QNEW ; NEW MEASURE NAME 56 . I ZI=3.1 Q ; SKIP THE COMPUTED FIELD 57 . S C0QFDA(FN,"+1,",ZI)=G(FN,C0QIEN_",",ZI,"I") 58 D UPDIE ; CREATE THE NEW RECORD 59 S DIE=$$C0QQFN ; GET READY TO EDIT IT 60 D EN^DIB ; EDIT THE NEW RECORD 61 Q 62 ; 63 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 64 K ZERR 65 D CLEAN^DILF 66 ZWR C0QFDA 67 D UPDATE^DIE("","C0QFDA","","ZERR") 68 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, 69 ; INVOKE THE ERROR TRAP IF TASKED 70 K C0QFDA 71 Q 72 ; -
qrda/C0Q/trunk/p/C0QMAIN.m
r1361 r1364 1 1 C0QMAIN ; GPL - Quality Reporting Main Processing ;10/13/10 17:05 2 ;;0.1;C0Q;nopatch;noreleasedate;Build 2 62 ;;0.1;C0Q;nopatch;noreleasedate;Build 27 3 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QMU12.m
r1361 r1364 1 1 C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm 2 ;;1.0;MU PACKAGE;;;Build 2 62 ;;1.0;MU PACKAGE;;;Build 27 3 3 ; 4 4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU … … 67 67 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists 68 68 S ZYR="MU12-" 69 N G1 ; ONE SET OF VALUES - RNF1 FORMAT70 ; INITIALIZE LISTS71 ; this is done so that if there are no matching patients, the patient list72 ; will be zeroed out73 S C0QLIST(ZYR_"HasDemographics")=""74 S C0QLIST(ZYR_"Patient")=""75 S C0QLIST(ZYR_"HasProblem")=""76 S C0QLIST(ZYR_"HasAllergy")=""77 S C0QLIST(ZYR_"HasMed")=""78 S C0QLIST(ZYR_"HasVitalSigns")=""79 S C0QLIST(ZYR_"HasMedOrders")=""80 S C0QLIST(ZYR_"HasSmokingStatus")=""81 D ALL ; all currently admitted patients in the hospital82 D DIS ; all patients discharged since the reporting period began83 I C0QSS ZWR GRSLT84 D ICUPAT ; GENERATE ICU PATIENT LIST85 I C0QPL D ;86 . D FILE ; FILE THE PATIENT LISTS87 . D UPDATE^C0QUPDT(.G,10) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR88 . D UPDATE^C0QUPDT(.G,11) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR89 Q90 ;91 BUILD2 ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create92 ; patient lists93 ;N GRSLT ; ARRAY FOR RESULTS94 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array95 I '$D(C0QPR) S C0QPR=0 ;default don't print out results96 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists97 S ZYR="MU12-"98 69 D INITCLST ; initialize C0QLIST 99 70 N G1 ; ONE SET OF VALUES - RNF1 FORMAT … … 107 78 . D DIS ; all patients discharged since the reporting period began 108 79 . I C0QSS ZWR GRSLT 109 . D ICUPAT ; GENERATE ICU PATIENT LIST80 . ;D ICUPAT ; GENERATE ICU PATIENT LIST 110 81 . I C0QPL D ; 111 82 . . D FILE ; FILE THE PATIENT LISTS … … 212 183 ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4 213 184 N BEG,END 214 S BEG=$$DT^C0 PCUR("JULY 3,2011")215 S END=$$DT^C0 PCUR("NOW")185 S BEG=$$DT^C0QUTIL("JULY 3,2011") 186 S END=$$DT^C0QUTIL("NOW") 216 187 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400 217 188 N C0QMEDS … … 832 803 S DFN="" 833 804 S ZYR=ZYR_"EP-" 834 F S DFN=$O(C0QLIST(ZYR_" EP-ALL-PATIENTS",DFN)) Q:DFN="" D ; EACH PATIENT805 F S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN="" D ; EACH PATIENT 835 806 . D DEMO 836 807 . D PROBLEM -
qrda/C0Q/trunk/p/C0QNOTES.m
r1361 r1364 1 1 C0QNOTES ;GPL - Utility to look up patient notes ;9/5/11 8:50pm 2 ;;1.0;MU PACKAGE;;;Build 2 62 ;;1.0;MU PACKAGE;;;Build 27 3 3 ; 4 4 ;2011 George Lilly <glilly@glilly.net> - Licensed under the terms of the GNU -
qrda/C0Q/trunk/p/C0QPQRI.m
r1361 r1364 1 1 C0QPQRI ; GPL - GENERATES A PQRI XML FILE ;6/14/11 17:05 2 ;;0.1;C0C;nopatch;noreleasedate;Build 2 62 ;;0.1;C0C;nopatch;noreleasedate;Build 27 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QPRML.m
r1361 r1364 1 1 C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm 2 ;;1.0;MU PACKAGE;;;Build 2 62 ;;1.0;MU PACKAGE;;;Build 27 3 3 ; 4 4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU -
qrda/C0Q/trunk/p/C0QSET.m
r1361 r1364 1 1 C0QSET ;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm 2 ;;1.0;MU PACKAGE;;;Build 2 62 ;;1.0;MU PACKAGE;;;Build 27 3 3 ; 4 4 ;2011 George Lilly glilly@glilly.net - Licensed under the terms of the GNU -
qrda/C0Q/trunk/p/C0QUPDT.m
r1361 r1364 1 1 C0QUPDT ; GPL - Quality Reporting List Update Routines ;8/29/11 17:05 2 ;;0.1;C0Q;nopatch;noreleasedate;Build 2 62 ;;0.1;C0Q;nopatch;noreleasedate;Build 27 3 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QUTIL.m
r1361 r1364 1 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm 2 ;;1.0;MU PACKAGE;;;Build 26 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 END ;end of C0QUTIL 1 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm 2 ;;1.0;MU PACKAGE;;;Build 27 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.
