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/C0QINIT.m

    r1364 r1438  
    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  ;
     1C0QINIT ; GPL - Quality Reporting Initialization Routines ; 5/23/12 5:43pm
     2        ;;1.0;C0Q;;May 21, 2012;Build 43
     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        ;
     22C0QQFN()        Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE
     23C0QMFN()        Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
     24C0QMMFN()       Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
     25C0QMMNFN()      Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE
     26C0QMMDFN()      Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE
     27RLSTFN()        Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE
     28RLSTPFN()       Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE
     29C0QALFN()       Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
     30        ;
     31COPYQ   ; 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        ;
     63UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     64        K ZERR
     65        D CLEAN^DILF
     66        ZWRITE 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        ;
Note: See TracChangeset for help on using the changeset viewer.