source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAFDA1.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1GMRAFDA1 ;HIRMFO/WAA-SELECT PATIENT AND PRINTER FOR REPORTS PRINT OUT ;12/1/95 11:23
2 ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
3EN1 ;Entry to PRINT AN FDA REPORT FOR A PATIENT option
4 S GMRAOUT=0,GMRALAGO=0 D EN1^GMRAU85 G:GMRAPA1'>0 EXIT
5 S GMRANAM=$P($G(^DPT($P(GMRAPA(0),U),0)),U)
6 D DEV1
7 D EXIT
8 Q
9DEV1 W !,"THIS REPORT SHOULD BE SENT TO A 132 COLUMN PRINTER.",!
10 S GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY AGAIN LATER" S GMRAOUT=1 Q
11 I $D(IO("Q")) D Q
12 .S ZTSAVE("GMRAPA1")="",ZTRTN="PRINT^GMRAFDA1",ZTDESC="Produce FDA Report for "_GMRANAM
13 .D ^%ZTLOAD K IO("Q")
14 .W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
15 .Q
16 D PRINT Q
17 Q
18PRINT ; ENTRY POINT TO BEGIN PRINTING THIS REPORT
19 U IO D PRT U IO(0)
20 D CLOSE^GMRAUTL
21 Q
22PRT D ^GMRAFN1
23 I $D(^TMP($J,"GMR")) D PRINT2 W @IOF
24 Q
25PRINT2 ;PRINT THE SECOND PAGE OF ANY REMAINING DATA
26 D ;HEADER INFORMATION
27 .N GMRASUS,GMRATAB
28 .W !,"ATTACHMENT PAGE"
29 .W !,"PATIENT ID: ",GMRAID
30 .S GMRASUS=$P(GMRAPA1(0),U,15)
31 .I GMRASUS>0 S GMRATAB=66-((20+$L($P($G(^GMR(120.8,GMRASUS,0)),U,2)))/2) W ?GMRATAB,"SUSPECT MEDICATION: ",$P($G(^GMR(120.8,GMRASUS,0)),U,2)
32 .W ?100,"DATE OF EVENT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),2)
33 .Q
34 I $D(^TMP($J,"GMR","R")) D
35 .W ! F I=1:1:132 W "-"
36 .W !,"Section B. Part 5. Describe event Continued" S GMRAX=0
37 .S DIWL=5,DIWR=128,DIWF="" K ^UTILITY($J,"W",5) S GMRAX=0 ;D K ^UTILITY($J,"W",5)
38 .F S GMRAX=$O(^TMP($J,"GMR","R",GMRAX)) Q:GMRAX<1 S X=^TMP($J,"GMR","R",GMRAX) D ^DIWP
39 .K ^TMP($J,"GMR","R")
40 .S X=0 F S X=$O(^UTILITY($J,"W",5,X)) Q:X<1 S ^TMP($J,"GMR","R",X)=$G(^UTILITY($J,"W",5,X,0))
41 .F S GMRAX=$O(^TMP($J,"GMR","R",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
42 ..W !,$S($D(^TMP($J,"GMR","R",GMRAX+1)):^TMP($J,"GMR","R",GMRAX),1:$E(^TMP($J,"GMR","R",GMRAX),1,($L(^TMP($J,"GMR","R",GMRAX))-2)))
43 ..Q
44 .Q
45 I $D(^TMP($J,"GMR","T")) D
46 .W ! F I=1:1:132 W "-"
47 .W !,"Section B. Part 6. Relevant Test/Laboratory Data Continued:"
48 .S GMRAX=0 F S GMRAX=$O(^TMP($J,"GMR","T",GMRAX)) Q:GMRAX'>0 D Q:GMRAOUT
49 ..W !,"TEST: ",$P(^TMP($J,"GMR","T",GMRAX),U)," RESULTS: ",$P(^(GMRAX),U,2) S Y=$P(^(GMRAX),U,3) W:Y'="" " COLLECTION DATE: ",$$FMTE^XLFDT(Y,"2") K Y
50 ..Q
51 .Q
52 I $D(^TMP($J,"GMR","O")) D
53 .S DIWL=5,DIWR=128,DIWF="" K ^UTILITY($J,"W",5) S GMRAX=0 ;D K ^UTILITY($J,"W",5)
54 .F S GMRAX=$O(^TMP($J,"GMR","O",GMRAX)) Q:GMRAX<1 S X=^TMP($J,"GMR","O",GMRAX) D ^DIWP
55 .K ^TMP($J,"GMR","O")
56 .S X=0 F S X=$O(^UTILITY($J,"W",5,X)) Q:X<1 S ^TMP($J,"GMR","O",X)=$G(^UTILITY($J,"W",5,X,0))
57 .W ! F I=1:1:132 W "-"
58 .W !,"Section B. Part 7. Other Relevant History Continued" S GMRAX=0
59 .F S GMRAX=$O(^TMP($J,"GMR","O",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
60 ..W !,^TMP($J,"GMR","O",GMRAX)
61 ..Q
62 .Q
63 I $D(^TMP($J,"GMR","C")) D
64 .W ! F I=1:1:132 W "-"
65 .W !,"Section C. Part 10. Concomitant Drugs Continued" S GMRAX=0
66 .F S GMRAX=$O(^TMP($J,"GMR","C",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
67 ..W !,$P(^TMP($J,"GMR","C",GMRAX),"^"),?60 S X=$P(^(GMRAX),"^",2) W:X]"" $E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X=$P(^(GMRAX),"^",3) W:X]"" "-",$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
68 ..Q
69 .Q
70 Q
71EXIT ;
72 K ^TMP($J,"GMR")
73 D KILL^XUSCLEAN
74 Q
75LKP ; ADDITIONAL LOOKUP ON 120.85
76 N GMRA S GMRA=$G(^GMR(120.85,+Y,0))
77 I $P(GMRA,U)'="" W " ",$$FMTE^XLFDT($P(^GMR(120.85,+Y,0),U),"2S")
78 I $P(GMRA,U,15)'="" W " ",$P($G(^GMR(120.8,$P(GMRA,U,15),0)),U,2)
79 W $E(@(DIC_+Y_",0)"),0)
80 Q
81SET ; set up variables for question mark help
82 S X=GMRANAM,DLAYGO=120.85,DIC="^GMR(120.85,",DIC(0)="E",D="D",DIC("W")="D LKP^GMRAFDA1",DZ="??"
83 S DIC("S")="I $P(^(0),U,2)=DFN S GMRA1208=+$P(^(0),U,15) I $$ERCHK^GMRAFDA1"
84 Q
85ERCHK() ; check for "ER" node to screen out entered-in-error entries
86 I '$D(^GMR(120.8,+GMRA1208,0)) Q 1
87 I '$D(^GMR(120.8,+GMRA1208,"ER")) Q 1
88 Q 0
Note: See TracBrowser for help on using the repository browser.