- 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/GMRAPU.m
r613 r623 1 GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ;8/27/93 2 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5 3 EN1 ; This routine will loop through the GMRA patient allergy file (120.8) 4 ; to find all patients with unverified reactions 5 ; 6 S GMRAOUT=0 D PRINTER 7 EXIT ; Exit of program kill cleanup 8 D KILL^XUSCLEAN 9 K ^TMP($J,"GMRAPU") 10 Q 11 PRINTER ;Select printer 12 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 13 I $D(IO("Q")) D Q 14 . S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")="" 15 . S ZTDESC="List of Unverified Reactions by Ward Location" D ^%ZTLOAD 16 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 17 . Q 18 U IO D PRINT U IO(0) 19 Q 20 PRINT ;Queue point for report 21 K ^TMP($J,"GMRAPU") D FIND 22 REPORT ; Print out the report 23 S GMRAOUT=$G(GMRAOUT) 24 S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT 25 I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT" 26 F S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC="" D HEAD Q:GMRAOUT D Q:GMRAOUT 27 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 28 ..S GMADFN=0 F S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1 D Q:GMRAOUT 29 ...S GMRASSN="",GMRARB="" 30 ...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB) 31 ...W !,GMRARB,$S(GMRARB'="":" ",1:""),GMRANAM," (",GMRASSN,")" 32 ...S GMADT=0 F S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1 S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 33 ....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 34 ....Q:GMRAPA(0)="" 35 ....W !,?3,$$FMTE^XLFDT(GMADT,"1") 36 ....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>") 37 ....W ?55,$E($P(GMRAPA(0),U,2),1,24) 38 ....I $Y>(IOSL-4) D HEAD 39 ....Q 40 ...Q 41 ..Q 42 .Q 43 D CLOSE^GMRAUTL 44 Q 45 HEAD ; Print header information 46 I $E(IOST,1)="C" D Q:GMRAOUT 47 .I GMRAPG=1 W @IOF Q 48 .I GMRAPG'=1 D Q:GMRAOUT 49 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 50 ..K Y 51 ..Q 52 .Q 53 Q:GMRAOUT 54 I GMRAPG'=1 W @IOF 55 W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG 56 W !,?19,"List of Unverified Reactions by Ward Location" 57 W !,?30,"Ward Location: ",GMALOC 58 W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction" 59 W !,$$REPEAT^XLFSTR("-",78) 60 S GMRAPG=GMRAPG+1 61 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 62 Q 63 FIND ; This subroutines will build the data for the report. 64 N GMADFN 65 S GMADFN=0 66 F S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1 D 67 .N GMRALOC,GMRANAM,GMALOC,GMRAPA 68 .S GMRANAM="",GMRALOC="" 69 .Q:'$$PRDTST^GMRAUTL1(GMADFN) ;GMRA*4*33 Exclude test patients if production or legacy environment. 70 .D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT" 71 .E S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U) 72 .Q:GMALOC="" 73 .S GMRAPA=0 74 .F S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1 D 75 ..N GMADT 76 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 77 ..S GMADT=$P(GMRAPA(0),U,4) 78 ..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)="" 79 ..Q 80 .Q 81 Q 1 GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ; 8/27/93 2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 3 EN1 ; This routine will loop through the GMRA patient allergy file (120.8) 4 ; to find all patients with unverified reactions 5 ; 6 S GMRAOUT=0 D PRINTER 7 EXIT ; Exit of program kill cleanup 8 D KILL^XUSCLEAN 9 K ^TMP($J,"GMRAPU") 10 Q 11 PRINTER ;Select printer 12 W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q 13 I $D(IO("Q")) D Q 14 . S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")="" 15 . S ZTDESC="List of Unverified Reactions by Ward Location" D ^%ZTLOAD 16 . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.") 17 . Q 18 U IO D PRINT U IO(0) 19 Q 20 PRINT ;Queue point for report 21 K ^TMP($J,"GMRAPU") D FIND 22 REPORT ; Print out the report 23 S GMRAOUT=$G(GMRAOUT) 24 S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT 25 I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT" 26 F S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC="" D HEAD Q:GMRAOUT D Q:GMRAOUT 27 .S GMRANAM="" F S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM="" D Q:GMRAOUT 28 ..S GMADFN=0 F S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1 D Q:GMRAOUT 29 ...S GMRASSN="",GMRARB="" 30 ...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB) 31 ...W !,GMRARB,$S(GMRARB'="":" ",1:""),GMRANAM," (",GMRASSN,")" 32 ...S GMADT=0 F S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1 S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT 33 ....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) 34 ....Q:GMRAPA(0)="" 35 ....W !,?3,$$FMTE^XLFDT(GMADT,"1") 36 ....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>") 37 ....W ?55,$E($P(GMRAPA(0),U,2),1,24) 38 ....I $Y>(IOSL-4) D HEAD 39 ....Q 40 ...Q 41 ..Q 42 .Q 43 D CLOSE^GMRAUTL 44 Q 45 HEAD ; Print header information 46 I $E(IOST,1)="C" D Q:GMRAOUT 47 .I GMRAPG=1 W @IOF Q 48 .I GMRAPG'=1 D Q:GMRAOUT 49 ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1 50 ..K Y 51 ..Q 52 .Q 53 Q:GMRAOUT 54 I GMRAPG'=1 W @IOF 55 W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG 56 W !,?19,"List of Unverified Reactions by Ward Location" 57 W !,?30,"Ward Location: ",GMALOC 58 W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction" 59 W !,$$REPEAT^XLFSTR("-",78) 60 S GMRAPG=GMRAPG+1 61 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user 62 Q 63 FIND ; This subroutines will build the data for the report. 64 N GMADFN 65 S GMADFN=0 66 F S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1 D 67 .N GMRALOC,GMRANAM,GMALOC,GMRAPA 68 .S GMRANAM="",GMRALOC="" 69 .D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT" 70 .E S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U) 71 .Q:GMALOC="" 72 .S GMRAPA=0 73 .F S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1 D 74 ..N GMADT 75 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" 76 ..S GMADT=$P(GMRAPA(0),U,4) 77 ..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)="" 78 ..Q 79 .Q 80 Q
Note:
See TracChangeset
for help on using the changeset viewer.
