| [623] | 1 | GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97 14:13
|
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
|
|---|
| 3 | EN1 ; This routine will loop thourgh the GMRA patient allergy file
|
|---|
| 4 | ; to find all patient within the date range that meet the critera
|
|---|
| 5 | ; and then display all the data for those patients first by location
|
|---|
| 6 | ; then by date/time range of the reaction.
|
|---|
| 7 | ; First select a starting date.
|
|---|
| 8 | ; then select an end date.
|
|---|
| 9 | ; then select a print device.
|
|---|
| 10 | ; GMAST = START DATE
|
|---|
| 11 | ; GMAEN = END DATE
|
|---|
| 12 | ;
|
|---|
| 13 | S GMRAOUT=0
|
|---|
| 14 | D DT G:GMRAOUT EXIT
|
|---|
| 15 | S GMAPG=1
|
|---|
| 16 | D DEVICE
|
|---|
| 17 | D EXIT
|
|---|
| 18 | Q
|
|---|
| 19 | GET ; This sub routine is to find all the reaction with in this observed
|
|---|
| 20 | ; date range.
|
|---|
| 21 | K ^TMP($J,"GMRAPL")
|
|---|
| 22 | N GMADT S GMADT=GMAST-.0001
|
|---|
| 23 | F S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1 Q:GMADT>GMAEN D
|
|---|
| 24 | .N GMRAPA S GMRAPA=0
|
|---|
| 25 | .F S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1 D
|
|---|
| 26 | ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
|
|---|
| 27 | ..; Stop if it is not Signed or if is E/E
|
|---|
| 28 | ..Q:GMRAPA(0)="" ; Bad Zero node
|
|---|
| 29 | ..Q:'$P(GMRAPA(0),U,12) ; Not signed off
|
|---|
| 30 | ..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U) ; Entered in error
|
|---|
| 31 | ..; Get patient name and location.
|
|---|
| 32 | ..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO
|
|---|
| 33 | ..S (GMRANAM,GMRALOC,GMRAVIP)=""
|
|---|
| 34 | ..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP)
|
|---|
| 35 | ..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
|
|---|
| 36 | ..I GMRALOC="" S GMRALOC="Out Patients"
|
|---|
| 37 | ..;Data format is as follows....
|
|---|
| 38 | ..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction)
|
|---|
| 39 | ..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)=""
|
|---|
| 40 | ..Q
|
|---|
| 41 | .Q
|
|---|
| 42 | Q
|
|---|
| 43 | PRINT ; Print data in the reaction global
|
|---|
| 44 | I $E(IOST,1)="C" W !,"One moment please...",!
|
|---|
| 45 | D GET
|
|---|
| 46 | S GMRALOC="" F S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC="" D Q:GMRAOUT
|
|---|
| 47 | .D HEAD Q:GMRAOUT
|
|---|
| 48 | .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT
|
|---|
| 49 | ..S GMRAVIP="" F S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP="" D Q:GMRAOUT
|
|---|
| 50 | ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
|
|---|
| 51 | ...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")"
|
|---|
| 52 | ...S GMRATYP="" F S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP="" D Q:GMRAOUT
|
|---|
| 53 | ....S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT
|
|---|
| 54 | .....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
|
|---|
| 55 | .....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered
|
|---|
| 56 | .....W ?20,$S($P(GMRAPA(0),U,5)'="":$E($P(^VA(200,$P(GMRAPA(0),U,5),0),U),1,25),1:"<None>") ;Who Entered it
|
|---|
| 57 | .....W ?46,GMRATYP ;Type of reaction
|
|---|
| 58 | .....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction
|
|---|
| 59 | .....I $Y>(IOSL-4) D HEAD
|
|---|
| 60 | .....Q
|
|---|
| 61 | ....Q
|
|---|
| 62 | ...Q
|
|---|
| 63 | ..Q
|
|---|
| 64 | .Q
|
|---|
| 65 | Q
|
|---|
| 66 | HEAD ; Header
|
|---|
| 67 | I $E(IOST,1)="C" D Q:GMRAOUT
|
|---|
| 68 | .I GMAPG=1 W @IOF Q
|
|---|
| 69 | .I GMAPG'=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 | I GMAPG'=1 W @IOF
|
|---|
| 75 | W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1
|
|---|
| 76 | W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC
|
|---|
| 77 | W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1")
|
|---|
| 78 | W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent"
|
|---|
| 79 | W !,$$REPEAT^XLFSTR("-",79)
|
|---|
| 80 | Q
|
|---|
| 81 | DEVICE ; Select a device to print on
|
|---|
| 82 | D NOW^%DTC S GMRAPDT=X
|
|---|
| 83 | W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
|
|---|
| 84 | I $D(IO("Q")) D Q
|
|---|
| 85 | . S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))=""
|
|---|
| 86 | . S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD
|
|---|
| 87 | . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
|
|---|
| 88 | . Q
|
|---|
| 89 | U IO D PRINT U IO(0)
|
|---|
| 90 | D CLOSE^GMRAUTL
|
|---|
| 91 | D EXIT
|
|---|
| 92 | Q
|
|---|
| 93 | DT ; Get dates
|
|---|
| 94 | S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q
|
|---|
| 95 | S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q
|
|---|
| 96 | S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected
|
|---|
| 97 | Q
|
|---|
| 98 | DATE(PROMPT,GMADATE) ; Date sub routine
|
|---|
| 99 | S GMADATE=$G(GMADATE)
|
|---|
| 100 | S DATE=""
|
|---|
| 101 | N DIR
|
|---|
| 102 | S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT
|
|---|
| 103 | D ^DIR I $D(DIRUT) S DATE="" Q DATE
|
|---|
| 104 | S DATE=Y
|
|---|
| 105 | Q DATE
|
|---|
| 106 | EXIT ;EXIT ROUTINE DATA
|
|---|
| 107 | K ^TMP($J,"GMRAPL")
|
|---|
| 108 | D KILL^XUSCLEAN
|
|---|
| 109 | Q
|
|---|
