- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPL.m
r613 r623 1 GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97 14:13 2 ;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5 3 EN1 ; This routine will loop through the GMRA patient allergy file 4 ; to find all patient within the date range that meet the criteria 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 ..Q:'$$PRDTST^GMRAUTL1($P($G(GMRAPA(0)),U)) ;GMRA*4*33 Exclude test patient from report if production or legacy environment 35 ..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP) 36 ..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U) 37 ..I GMRALOC="" S GMRALOC="Out Patients" 38 ..;Data format is as follows.... 39 ..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction) 40 ..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)="" 41 ..Q 42 .Q 43 Q 44 PRINT ; Print data in the reaction global 45 I $E(IOST,1)="C" W !,"One moment please...",! 46 D GET 47 S GMRALOC="" F S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC="" D Q:GMRAOUT 48 .D HEAD Q:GMRAOUT 49 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 50 ..S GMRAVIP="" F S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP="" D Q:GMRAOUT 51 ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT 52 ...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")" 53 ...S GMRATYP="" F S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP="" D Q:GMRAOUT 54 ....S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 55 .....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 56 .....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered 57 .....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 58 .....W ?46,GMRATYP ;Type of reaction 59 .....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction 60 .....I $Y>(IOSL-4) D HEAD 61 .....Q 62 ....Q 63 ...Q 64 ..Q 65 .Q 66 Q 67 HEAD ; Header 68 I $E(IOST,1)="C" D Q:GMRAOUT 69 .I GMAPG=1 W @IOF Q 70 .I GMAPG'=1 D Q:GMRAOUT 71 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 72 ..K Y 73 ..Q 74 .Q 75 I GMAPG'=1 W @IOF 76 W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1 77 W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC 78 W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1") 79 W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent" 80 W !,$$REPEAT^XLFSTR("-",79) 81 Q 82 DEVICE ; Select a device to print on 83 D NOW^%DTC S GMRAPDT=X 84 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 85 I $D(IO("Q")) D Q 86 . S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))="" 87 . S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD 88 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 89 . Q 90 U IO D PRINT U IO(0) 91 D CLOSE^GMRAUTL 92 D EXIT 93 Q 94 DT ; Get dates 95 S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q 96 S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q 97 S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected 98 Q 99 DATE(PROMPT,GMADATE) ; Date sub routine 100 S GMADATE=$G(GMADATE) 101 S DATE="" 102 N DIR 103 S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT 104 D ^DIR I $D(DIRUT) S DATE="" Q DATE 105 S DATE=Y 106 Q DATE 107 EXIT ;EXIT ROUTINE DATA 108 K ^TMP($J,"GMRAPL") 109 D KILL^XUSCLEAN 110 Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
