Ignore:
Timestamp:
Aug 2, 2012, 8:59:21 PM (12 years ago)
Author:
Sam Habiel
Message:

Latest routines; T11 copy

File:
1 edited

Legend:

Unmodified
Added
Removed

  • qrda/C0Q/trunk/p/C0QKIDS.m

    r1484 r1501  
    1 C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/13/12 11:49am
    2         ;;1.0;C0Q;;May 21, 2012;Build 47
     1C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/31/12 3:01pm
     2        ;;1.0;C0Q;;May 21, 2012;Build 63
    33        ; Licensed under package license. See Documentation.
    44        ;
    5         ; PEPs: PRE, TRAN, POST
    6         ;
    7 PRE ; Unified Pre; PEP
    8         QUIT
     5        ; PEPs: TRAN, POST, PRE
     6        ;
    97TRAN    ; Unified Transport; PEP
    108        ; D TRAN301  ; looks like I won't send that file over
    11         D TRAN201
     9        D TRAN201 ; C0Q MEASUREMENT
     10        D TRAN101 ; C0Q QUALITY MEASURE
    1211        QUIT
    1312POST    ; Unified Post; PEP
    1413        ; D POST301  ; looks like I won't send that file over
    15         D POST101
    16         D POST201
     14        ; D POST101 ; C0Q QUALITY MEASURE ; As of T11, I won't do that anymore. -->
     15        ; I discovered that it will do it on destination systems that are set-up.
     16        ; So bad bad bad idea for me to do it in a post-init.
     17        ; ... I wrote TRAN101 to do the function of POST101.
     18        D POST201 ; C0Q MEASUREMENT
     19        QUIT
     20        ;
     21PRE     ; Unified Pre; PEP
     22        D PRE101
    1723        QUIT
    1824        ;
    1925        ; << >>
    2026        ;
     27TRAN101 ; Remove Untransportable pointers in C0Q QUALITY MEASURE; Private EP
     28        ; NB: I am reaching into KIDS's data here. This may not work for future versions
     29        ; of KIDS. However, I am exporting this only; once exported, it should work in
     30        ; any version of KIDS.
     31        N XPDIEN S XPDIEN=$QS(XPDGREF,2) ; Get IEN of KIDS Transport Global
     32        N X S X=$NA(^XTMP("XPDT",XPDIEN,"DATA",1130580001.101)) ; KIDS transports our data here
     33        N IEN S IEN=0 ; Looper
     34        F  S IEN=$O(@X@(IEN)) Q:'IEN  D  ; For each IEN, remove the following:
     35        . S $P(@X@(IEN,0),U,2)="" ; Numerator Patient List
     36        . S $P(@X@(IEN,0),U,3)="" ; Denominator Patient List
     37        . S $P(@X@(IEN,7),U,4)="" ; Negative Numerator List
     38        . S $P(@X@(IEN,7),U,2)="" ; Alternate Numerator List
     39        . S $P(@X@(IEN,7),U,3)="" ; Alternate Denominator List
     40        . S $P(@X@(IEN,7),U,5)="" ; Alternate Negative Numerator List
     41        QUIT
     42        ;
    2143TRAN301 ; Grab FDA for entire file C0Q PATIENT LIST and store in Transport Global; Private EP
     44        ; Not used. Dead code.
    2245        N C0QIEN S C0QIEN=0 ; IEN walker
    2346        N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
    … …  
    5679        ;
    5780POST201 ; File FDA for 201; Private EP
     81        ;
     82        ; Clean-up data if it already exists!
     83        ; ZWRITE ^C0Q(201,:,5,:,0)       
     84        ; ^C0Q(201,1,5,599,0)=50
     85        ; ^C0Q(201,1,5,600,0)=4
     86        ; ^C0Q(201,1,5,601,0)=39
     87        ; ^C0Q(201,1,5,602,0)=6
     88        ; ^C0Q(201,1,5,603,0)=7
     89        ; ^C0Q(201,1,5,604,0)=48
     90        ; ^C0Q(201,1,5,605,0)=46
     91        ;
    5892        IF $O(^C0Q(201,0)) DO  QUIT  ; Quit if data is already there.
    5993        . D MES^XPDUTL("Data exists in file C0Q MEASUREMENTS... Not adding new data")
     94        . D MES^XPDUTL("Cleaning up broken pointers in C0Q MEASUREMENTS from deleted data in C0Q QUALITY MEASURE")
     95        . ; This is very hairy code. Run through the 5 multiple in C0Q MEASUREMENT
     96        . ; Grab the IEN in the .01, check if it exists; if not, kill.
     97        . N DA,DIK ; DIK Variables; as well as our looper variables
     98        . S (DA,DA(1))=0 ; Initial looper values
     99        . F  S DA(1)=$O(^C0Q(201,DA(1))) Q:'DA(1)  D  ; Loop through entries
     100        . . D MES^XPDUTL("...Processing entry "_$P(^C0Q(201,DA(1),0),U))  ; msg
     101        . . S DIK="^C0Q(201,"_DA(1)_",5,"  ; deletion root for the next loop
     102        . . F  S DA=$O(^C0Q(201,DA(1),5,DA)) Q:'DA  D  ; For each Measure
     103        . . . N IEN S IEN=+^C0Q(201,DA(1),5,DA,0)  ; Get IEN
     104        . . . I IEN,'$D(^C0Q(101,IEN)) D  ; If IEN is numeric, IEN exists in dest file
     105        . . . . D MES^XPDUTL("......Deleting broken pointer "_IEN) ; msg
     106        . . . . D ^DIK ; delete
     107        ;
     108        ; If new install, add data
    60109        ;
    61110        D MES^XPDUTL("Adding data to C0Q MEASUREMENTS")
    … …  
    70119        ;
    71120POST301 ; Get FDA from Transport Global and install in destination system for C0Q PATIENT LIST; Private EP
     121        ; Not used. Dead code.
    72122        N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.301")) ; FDA array name is the global reference
    73123        N C0QERR ; Error
    … …  
    79129        QUIT
    80130        ;
    81 POST101 ; Clean transported data from broken pointers in C0Q QUALITY MEASURE in destination systems; Private EP
    82         D MES^XPDUTL("Cleaning C0Q QUALITY MEASURE data")
    83         N C0QIEN S C0QIEN=0 ; Ien looper
    84         N C0QFDA ; Fileman Data Array
    85         F  S C0QIEN=$O(^C0Q(101,C0QIEN)) Q:'+C0QIEN  DO  ; For each record, delete these fields
    86         . S C0QFDA(1130580001.101,C0QIEN_",",1)="@" ; NUMERATOR PATIENT LIST
    87         . S C0QFDA(1130580001.101,C0QIEN_",",1.5)="@" ; NEGATIVE NUMERATOR LIST
    88         . S C0QFDA(1130580001.101,C0QIEN_",",2)="@" ; DENOMINATOR PATIENT LIST
    89         . ; ---
    90         . ; I wasn't planning on emptying these out, but the IENs in desintation systems may be different
    91         . ; so it is best to remove them for now. It's a pointer field, so IENs are important.
    92         . ; Desination file is populated automatically, but only at the site, and only after config.
    93         . ; So we can't really ship the pointers as part of the install.
    94         . ; ---
    95         . S C0QFDA(1130580001.101,C0QIEN_",",1.1)="@" ; ALTERNATIVE NUMERATOR LIST
    96         . S C0QFDA(1130580001.101,C0QIEN_",",1.51)="@" ; ALTERNATE NEGATIVE NUM LIST
    97         . S C0QFDA(1130580001.101,C0QIEN_",",2.1)="@" ; ALTERNATIVE DENOMINATOR LIST
    98         N C0QERR ; Errors
    99         D FILE^DIE("","C0QFDA","C0QERR") ; Do it!
    100         I $D(C0QERR) D  ; if there's an error, print it out
    101         . D MES^XPDUTL("Couldn't fix data into C0Q QUALITY MEASURE file")
    102         . S C0QERR=$Q(C0QERR)
    103         . F  S C0QERR=$Q(@C0QERR) Q:C0QERR=""  D MES^XPDUTL(C0QERR_": "_@C0QERR)
    104         QUIT
    105         ;
    106         ; Code below taken from PXRMP15I
    107         ;===============================================================
     131PRE101  ; Clean existing data (from an earlier installation) from measures that are now merged to other measures
     132        ; in C0Q QUALITY MEASURE in destination systems; Private EP
     133        ;
     134        ; Quit if C0Q Quality Measures isn't on the system.
     135        Q:'$D(^C0Q(101))
     136        ;
     137        D MES^XPDUTL("Removing subsumed entries in C0Q QUALITY MEASURE")
     138        ;
     139        ; .01 field values to for records to remove
     140        N C0QLIST
     141        S C0QLIST("TEST M0028A")=""
     142        S C0QLIST("MU EP 0028B")=""
     143        S C0QLIST("M0013")=""
     144        S C0QLIST("M0024")=""
     145        S C0QLIST("M1")=""
     146        S C0QLIST("M3")=""
     147        S C0QLIST("M2")=""
     148        S C0QLIST("M0028")=""
     149        S C0QLIST("M111")=""
     150        S C0QLIST("M112")=""
     151        S C0QLIST("M113")=""
     152        S C0QLIST("M128")=""
     153        S C0QLIST("M5")=""
     154        S C0QLIST("M7")=""
     155        S C0QLIST("M0022")=""
     156        S C0QLIST("12")=""
     157        S C0QLIST("M0038")=""
     158        S C0QLIST("M110")=""
     159        S C0QLIST("MU EP NQF 0070")=""
     160        ;
     161        ; Root for ^DIK
     162        N DIK S DIK="^C0Q(101,"
     163        ;
     164        ; Loop through list, find IEN for each one, kill off
     165        N C0QITEM S C0QITEM=""                             ; Item
     166        F  S C0QITEM=$O(C0QLIST(C0QITEM)) Q:C0QITEM=""  D  ; Loop
     167        . Q:'$DATA(^C0Q(101,"B",C0QITEM))                  ; Quit if not present.
     168        . N DA S DA=$O(^C0Q(101,"B",C0QITEM,""))           ; IEN
     169        . ; The original software has MU EP NQF 0070 incorrectly. If the 1 node
     170        . ; has Pneumonia, we want to remove that entry.
     171        . I C0QITEM="MU EP NQF 0070",^C0Q(101,DA,1)'["Pneumonia" QUIT
     172        . D MES^XPDUTL("...Removing "_C0QITEM)                ; Message to user
     173        . D ^DIK                                           ; Delete
     174        ;
     175REN     ; Rename a bunch of entries
     176        ; ("OLD NAME")="NEW NAME"
     177        D MES^XPDUTL("Renaming Old entries in C0Q QUALITY MEASURE")
     178        ;
     179        N C0QLIST
     180        S C0QLIST("NQF0038 NUM1 DPT")="MU EP NQF 0038 NUM1 DPT"
     181        S C0QLIST("NQF0038 NUM10")="MU EP NQF 0038 NUM10 FLU"
     182        S C0QLIST("NQF0038 NUM11 COMBO5")="MU EP NQF 0038 NUM11 COMBO5"
     183        S C0QLIST("NQF0038 NUM12 COMBO6")="MU EP NQF 0038 NUM12 COMBO6"
     184        S C0QLIST("NQF0038 NUM2 IPV")="MU EP NQF 0038 NUM2 IPV"
     185        S C0QLIST("NQF0038 NUM3 MMR")="MU EP NQF 0038 NUM3 MMR"
     186        S C0QLIST("NQF0038 NUM4 HiB")="MU EP NQF 0038 NUM4 HiB"
     187        S C0QLIST("NQF0038 NUM5 HEP B")="MU EP NQF 0038 NUM5 HEP B"
     188        S C0QLIST("NQF0038 NUM6 VZV")="MU EP NQF 0038 NUM6 VZV"
     189        S C0QLIST("NQF0038 NUM7 PCV")="MU EP NQF 0038 NUM7 PCV"
     190        S C0QLIST("NQF0038 NUM8 HEP A")="MU EP NQF 0038 NUM8 HEP A"
     191        S C0QLIST("NQF0038 NUM9")="MU EP NQF 0038 NUM9 RV"
     192        S C0QLIST("M124")="PQRI MEASURE 124"
     193        S C0QLIST("M173")="PQRI MEASURE 173"
     194        S C0QLIST("M39")="PQRI MEASURE 39"
     195        S C0QLIST("M47")="PQRI MEASURE 47"
     196        S C0QLIST("M48")="PQRI MEASURE 48"
     197        ;
     198        N C0QITEM S C0QITEM=""                              ; Item
     199        N C0QFDA                                            ; FDA
     200        F  S C0QITEM=$O(C0QLIST(C0QITEM))  Q:C0QITEM=""  D  ; Loop through
     201        . N IEN S IEN=$O(^C0Q(101,"B",C0QITEM,""))          ; Get IEN from File using old name
     202        . I IEN S C0QFDA(1130580001.101,IEN_",",.01)=C0QLIST(C0QITEM)  ; If found, put new name in FDA for this IEN
     203        . I IEN D MES^XPDUTL("...Renaming "_C0QITEM_" to "_C0QLIST(C0QITEM)) ; Print message to user
     204        ;
     205        N C0QERR                                            ; Error for FILE^DIE
     206        I $D(C0QFDA) D FILE^DIE("E",$NA(C0QFDA),$NA(C0QERR))  ; File if FDA has contents
     207        E  D MES^XPDUTL("No entries to rename")             ; If nothing, tell user so
     208        ;
     209        D:$D(C0QERR)                                        ; If Error, print it
     210        . D MES^XPDUTL("Error Filing Data. FILE^DIE reported:")
     211        . N REF S REF=$NA(C0QERR)                           ; $Q Reference
     212        . F  S REF=$Q(@REF) Q:REF=""  D MES^XPDUTL(REF_"="_@REF) ; Loop and Print
     213        ;
     214        QUIT
Note: See TracChangeset for help on using the changeset viewer.