Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST4.m

    r613 r623  
    1 GMRAPST4        ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY DC ;3/5/97  15:15
    2         ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
    3 EN1     ; This routine will loop through the ADT entry point to get all
    4         ; the entries in that date range.
    5         S GMRAOUT=0
    6         W !,"Select an Observed date range for this report."
    7         D DT^GMRAPL G:GMRAOUT EXIT
    8         D PRINTER
    9 EXIT    ; Exit of program kill cleanup
    10         K ^TMP($J,"GMRAPST4")
    11         D KILL^XUSCLEAN
    12         Q
    13 PRINTER ;Select printer
    14         W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
    15         I $D(IO("Q")) D  Q
    16         . S ZTRTN="PRINT^GMRAPST4",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
    17         . S ZTDESC="Frequency Distribution of Drug Classes" D ^%ZTLOAD
    18         . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
    19         . Q
    20         U IO D PRINT U IO(0)
    21         Q
    22 PRINT   ;Queue point for report
    23         ;loop through the 120.85 file and look for the field that
    24         D NOW^%DTC S GMRADPDT=X
    25         S GMRADATE=GMAST-.0001,GMRAPG=1
    26         K ^TMP($J,"GMRAPST4")
    27         S GMRATOT=0
    28         F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
    29         .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
    30         ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
    31         ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
    32         ..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2))  ;GMRA*4*33  Exclude test patient from report if production or legacy environment.
    33         ..S GMRATOT=GMRATOT+1
    34         ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
    35         ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
    36         ..S GMRADC=0
    37         ..F  S GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) Q:GMRADC<1  D
    38         ...S GMRADCN=$P($G(^GMR(120.8,GMRAPA,3,GMRADC,0)),U) Q:GMRADCN=""
    39         ...S ^TMP($J,"GMRAPST4",GMRADCN)=$G(^TMP($J,"GMRAPST4",GMRADCN))+1
    40         ...Q
    41         ..Q
    42         .Q
    43         Q:GMRAOUT
    44         Q:'$D(^TMP($J,"GMRAPST4"))
    45         S GMRADCN=0
    46         ;Sort in value order.
    47         F  S GMRADCN=$O(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADCN<1  D
    48         .S GMRADC=$G(^TMP($J,"GMRAPST4",GMRADCN))  Q:GMRADC<1
    49         .S ^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)=""
    50         .Q
    51         D HEAD
    52         S GMRADC=""
    53         F  S GMRADC=$O(^TMP($J,"GMRAPST4","B",GMRADC),-1) Q:GMRADC<1  D  Q:GMRAOUT
    54         .S GMRADCN=0
    55         .F  S GMRADCN=$O(^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)) Q:GMRADCN<1  D  Q:GMRAOUT
    56         ..S GMRADC0=$G(^PS(50.605,GMRADCN,0)) Q:GMRADC0=""
    57         ..S GMRATAB=30-$L($E($P(GMRADC0,U,2),1,30))
    58         ..W !,?GMRATAB,$E($P(GMRADC0,U,2),1,30)," (",$P(GMRADC0,U),") :",$J(GMRADC,5)
    59         ..D HEAD Q:GMRAOUT
    60         ..Q
    61         .Q
    62         W !!,?22,"Total number of records processed ",GMRATOT
    63         D CLOSE^GMRAUTL
    64         Q
    65 HEAD    ; Print header information
    66         I GMRAPG'=1  Q:$Y<(IOSL-4)
    67         I $E(IOST,1)="C" D  Q:GMRAOUT
    68         .I GMRAPG=1 W @IOF Q
    69         .I GMRAPG'=1 D  Q:GMRAOUT
    70         ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
    71         ..K Y
    72         ..Q
    73         .Q
    74         Q:GMRAOUT
    75         I GMRAPG'=1 W @IOF
    76         W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
    77         W !,?20,"Frequency Distribution of Drug Classes"
    78         W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
    79         W !,"Drug Class",?39,"Number"
    80         W !,$$REPEAT^XLFSTR("-",79)
    81         S GMRAPG=GMRAPG+1
    82         I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
    83         Q
     1GMRAPST4 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY DC ;3/5/97  15:15
     2 ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
     3EN1 ; This routine will loop through the ADT entry point to get all
     4 ; the entries in that date range.
     5 S GMRAOUT=0
     6 W !,"Select an Observed date range for this report."
     7 D DT^GMRAPL G:GMRAOUT EXIT
     8 D PRINTER
     9EXIT ; Exit of program kill cleanup
     10 K ^TMP($J,"GMRAPST4")
     11 D KILL^XUSCLEAN
     12 Q
     13PRINTER ;Select printer
     14 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
     15 I $D(IO("Q")) D  Q
     16 . S ZTRTN="PRINT^GMRAPST4",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
     17 . S ZTDESC="Frequency Distribution of Drug Classes" D ^%ZTLOAD
     18 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
     19 . Q
     20 U IO D PRINT U IO(0)
     21 Q
     22PRINT ;Queue point for report
     23 ;loop through the 120.85 file and look for the field that
     24 D NOW^%DTC S GMRADPDT=X
     25 S GMRADATE=GMAST-.0001,GMRAPG=1
     26 K ^TMP($J,"GMRAPST4")
     27 S GMRATOT=0
     28 F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
     29 .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
     30 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
     31 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
     32 ..S GMRATOT=GMRATOT+1
     33 ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
     34 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
     35 ..S GMRADC=0
     36 ..F  S GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) Q:GMRADC<1  D
     37 ...S GMRADCN=$P($G(^GMR(120.8,GMRAPA,3,GMRADC,0)),U) Q:GMRADCN=""
     38 ...S ^TMP($J,"GMRAPST4",GMRADCN)=$G(^TMP($J,"GMRAPST4",GMRADCN))+1
     39 ...Q
     40 ..Q
     41 .Q
     42 Q:GMRAOUT
     43 Q:'$D(^TMP($J,"GMRAPST4"))
     44 S GMRADCN=0
     45 ;Sort in value order.
     46 F  S GMRADCN=$O(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADCN<1  D
     47 .S GMRADC=$G(^TMP($J,"GMRAPST4",GMRADCN))  Q:GMRADC<1
     48 .S ^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)=""
     49 .Q
     50 D HEAD
     51 S GMRADC=""
     52 F  S GMRADC=$O(^TMP($J,"GMRAPST4","B",GMRADC),-1) Q:GMRADC<1  D  Q:GMRAOUT
     53 .S GMRADCN=0
     54 .F  S GMRADCN=$O(^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)) Q:GMRADCN<1  D  Q:GMRAOUT
     55 ..S GMRADC0=$G(^PS(50.605,GMRADCN,0)) Q:GMRADC0=""
     56 ..S GMRATAB=30-$L($E($P(GMRADC0,U,2),1,30))
     57 ..W !,?GMRATAB,$E($P(GMRADC0,U,2),1,30)," (",$P(GMRADC0,U),") :",$J(GMRADC,5)
     58 ..D HEAD Q:GMRAOUT
     59 ..Q
     60 .Q
     61 W !!,?22,"Total number of records processed ",GMRATOT
     62 D CLOSE^GMRAUTL
     63 Q
     64HEAD ; Print header information
     65 I GMRAPG'=1  Q:$Y<(IOSL-4)
     66 I $E(IOST,1)="C" D  Q:GMRAOUT
     67 .I GMRAPG=1 W @IOF Q
     68 .I GMRAPG'=1 D  Q:GMRAOUT
     69 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
     70 ..K Y
     71 ..Q
     72 .Q
     73 Q:GMRAOUT
     74 I GMRAPG'=1 W @IOF
     75 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
     76 W !,?20,"Frequency Distribution of Drug Classes"
     77 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
     78 W !,"Drug Class",?39,"Number"
     79 W !,$$REPEAT^XLFSTR("-",79)
     80 S GMRAPG=GMRAPG+1
     81 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
     82 Q
Note: See TracChangeset for help on using the changeset viewer.