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

    r613 r623  
    1 GMRAPST3        ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY REACT ;3/5/97  15:14
    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         D KILL^XUSCLEAN
    11         K ^TMP($J,"GMRAPST3B")
    12         K ^TMP($J,"GMRAPST3A")
    13         Q
    14 PRINTER ;Select printer
    15         W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
    16         I $D(IO("Q")) D  Q
    17         . S ZTRTN="PRINT^GMRAPST3",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
    18         . S ZTDESC="Frequency Distribution of Causative Agents" D ^%ZTLOAD
    19         . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
    20         . Q
    21         U IO D PRINT U IO(0)
    22         Q
    23 PRINT   ;Queue point for report
    24         ;loop through the 120.85 file and look for the field that
    25         D NOW^%DTC S GMRADPDT=X
    26         S GMRADATE=GMAST-.0001,GMRAPG=1
    27         K ^TMP($J,"GMRAPST3A")
    28         S GMRATOT=0
    29         F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
    30         .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
    31         ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
    32         ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
    33         ..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2))  ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
    34         ..S GMRATOT=GMRATOT+1
    35         ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
    36         ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
    37         ..S GMRAREC=$P(GMRAPA(0),U,2)
    38         ..S ^TMP($J,"GMRAPST3A",GMRAREC)=$G(^TMP($J,"GMRAPST3A",GMRAREC))+1
    39         ..Q
    40         .Q
    41         Q:GMRAOUT
    42         Q:'$D(^TMP($J,"GMRAPST3A"))
    43         K ^TMP($J,"GMRAPST3B")
    44         S GMRAREC=""
    45         F  S GMRAREC=$O(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRAREC=""  D
    46         .S GMRARECN=$G(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRARECN=""
    47         .S ^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)=""
    48         .Q
    49         D HEAD
    50         S GMRARECN=""
    51         F  S GMRARECN=$O(^TMP($J,"GMRAPST3B",GMRARECN),-1) Q:GMRARECN<1  D  Q:GMRAOUT
    52         .S GMRAREC=""
    53         .F  S GMRAREC=$O(^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)) Q:GMRAREC=""  D  Q:GMRAOUT
    54         ..S GMRATAB=30-$L($E(GMRAREC,1,30))
    55         ..W !,?GMRATAB,$E(GMRAREC,1,30)," :",$J(GMRARECN,5)
    56         ..D HEAD Q:GMRAOUT
    57         ..Q
    58         .Q
    59         W !!,?22,"Total number of records processed ",GMRATOT
    60         D CLOSE^GMRAUTL
    61         Q
    62         ;has the patient died within the date
    63 HEAD    ; Print header information
    64         I GMRAPG'=1  Q:$Y<(IOSL-4)
    65         I $E(IOST,1)="C" D  Q:GMRAOUT
    66         .I GMRAPG=1 W @IOF Q
    67         .I GMRAPG'=1 D  Q:GMRAOUT
    68         ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
    69         ..K Y
    70         ..Q
    71         .Q
    72         Q:GMRAOUT
    73         I GMRAPG'=1 W @IOF
    74         W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
    75         W !,?20,"Frequency Distribution of Causative Agents"
    76         W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
    77         W !,"Causative Agents",?34,"Number"
    78         W !,$$REPEAT^XLFSTR("-",79)
    79         S GMRAPG=GMRAPG+1
    80         I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
    81         Q
     1GMRAPST3 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY REACT ;3/5/97  15:14
     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 D KILL^XUSCLEAN
     11 K ^TMP($J,"GMRAPST3B")
     12 K ^TMP($J,"GMRAPST3A")
     13 Q
     14PRINTER ;Select printer
     15 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
     16 I $D(IO("Q")) D  Q
     17 . S ZTRTN="PRINT^GMRAPST3",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
     18 . S ZTDESC="Frequency Distribution of Causative Agents" D ^%ZTLOAD
     19 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
     20 . Q
     21 U IO D PRINT U IO(0)
     22 Q
     23PRINT ;Queue point for report
     24 ;loop through the 120.85 file and look for the field that
     25 D NOW^%DTC S GMRADPDT=X
     26 S GMRADATE=GMAST-.0001,GMRAPG=1
     27 K ^TMP($J,"GMRAPST3A")
     28 S GMRATOT=0
     29 F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
     30 .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
     31 ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
     32 ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
     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 GMRAREC=$P(GMRAPA(0),U,2)
     37 ..S ^TMP($J,"GMRAPST3A",GMRAREC)=$G(^TMP($J,"GMRAPST3A",GMRAREC))+1
     38 ..Q
     39 .Q
     40 Q:GMRAOUT
     41 Q:'$D(^TMP($J,"GMRAPST3A"))
     42 K ^TMP($J,"GMRAPST3B")
     43 S GMRAREC=""
     44 F  S GMRAREC=$O(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRAREC=""  D
     45 .S GMRARECN=$G(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRARECN=""
     46 .S ^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)=""
     47 .Q
     48 D HEAD
     49 S GMRARECN=""
     50 F  S GMRARECN=$O(^TMP($J,"GMRAPST3B",GMRARECN),-1) Q:GMRARECN<1  D  Q:GMRAOUT
     51 .S GMRAREC=""
     52 .F  S GMRAREC=$O(^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)) Q:GMRAREC=""  D  Q:GMRAOUT
     53 ..S GMRATAB=30-$L($E(GMRAREC,1,30))
     54 ..W !,?GMRATAB,$E(GMRAREC,1,30)," :",$J(GMRARECN,5)
     55 ..D HEAD Q:GMRAOUT
     56 ..Q
     57 .Q
     58 W !!,?22,"Total number of records processed ",GMRATOT
     59 D CLOSE^GMRAUTL
     60 Q
     61 ;has the patient died with inthe dat
     62HEAD ; Print header information
     63 I GMRAPG'=1  Q:$Y<(IOSL-4)
     64 I $E(IOST,1)="C" D  Q:GMRAOUT
     65 .I GMRAPG=1 W @IOF Q
     66 .I GMRAPG'=1 D  Q:GMRAOUT
     67 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
     68 ..K Y
     69 ..Q
     70 .Q
     71 Q:GMRAOUT
     72 I GMRAPG'=1 W @IOF
     73 W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
     74 W !,?20,"Frequency Distribution of Causative Agents"
     75 W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
     76 W !,"Causative Agents",?34,"Number"
     77 W !,$$REPEAT^XLFSTR("-",79)
     78 S GMRAPG=GMRAPG+1
     79 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
     80 Q
Note: See TracChangeset for help on using the changeset viewer.