1 | GMRAFDA1 ;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
|
---|
3 | EN1 ;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
|
---|
9 | DEV1 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
|
---|
18 | PRINT ; ENTRY POINT TO BEGIN PRINTING THIS REPORT
|
---|
19 | U IO D PRT U IO(0)
|
---|
20 | D CLOSE^GMRAUTL
|
---|
21 | Q
|
---|
22 | PRT D ^GMRAFN1
|
---|
23 | I $D(^TMP($J,"GMR")) D PRINT2 W @IOF
|
---|
24 | Q
|
---|
25 | PRINT2 ;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
|
---|
71 | EXIT ;
|
---|
72 | K ^TMP($J,"GMR")
|
---|
73 | D KILL^XUSCLEAN
|
---|
74 | Q
|
---|
75 | LKP ; 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
|
---|
81 | SET ; 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
|
---|
85 | ERCHK() ; 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
|
---|