Ignore:
Timestamp:
May 25, 2012, 5:55:11 PM (12 years ago)
Author:
Sam Habiel
Message:

Updated routines after many small fixes; added C0QKIDS as well

File:
1 edited

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: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
     1C0QUTIL ;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        ;
     21AGE(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        ;
     44DTDIFF(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        ;
     75DT(X)   ; -- Returns FM date for X
     76        N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
     77        Q Y
     78            ;
     79END     ;end of C0QUTIL
Note: See TracChangeset for help on using the changeset viewer.