source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP3.m@ 1363

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1GMRADSP3 ;HIRMFO/YMP,RM,WAA-PRINT PATIENT A/AR ; 8/16/92
2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
3EN1 ;
4 S:'$D(GMRAOTH) GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
5 S GMRASP(1)="",GMRASP(2)="" D WRITE Q:GMRAOUT
6 S GMRAREA=0,GMRAFT=1
7 I $G(GMRAVFY,0) S GMRAHDR(1)=" SIGNS/SYMPTOMS: ",GMRASP(1)=0
8 E S GMRAHDR(1)="SIGNS/SYMPTOMS: ",GMRASP(1)=0
9 F S GMRAREA=$O(^GMR(120.8,GMRAPA,10,GMRAREA)) Q:GMRAREA<1 D Q:GMRAOUT
10 .N GMRAX,GMRAZ
11 .S GMRAX=$G(^GMR(120.8,GMRAPA,10,GMRAREA,0))
12 .Q:GMRAX=""
13 .I +GMRAX'=GMRAOTH S GMRALIN(1)=$E($S($D(^GMRD(120.83,+GMRAX,0)):$P(^(0),U),1:""),1,23)
14 .E S GMRALIN(1)=$P(GMRAX,U,2)
15 .S GMRAZ=$S($P(GMRAX,U,4)'="":$$FMTE^XLFDT($P(GMRAX,U,4),1),1:"")
16 .S:GMRAZ'="" GMRALIN(1)=GMRALIN(1)_" ("_GMRAZ_")"
17 .I $G(GMRAVFY,0),GMRAHDR(1)="" S GMRALIN(1)=" "_GMRALIN(1)
18 .D WRITE S GMRASP(1)=16,GMRAHDR(1)=""
19 .Q
20 Q:$G(GMRAVFY,0) ; Indicates this routine was run from verify part ART
21ENDING ;
22 S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
23 G:$P(GMRAPA(0),U,14)="" SEVERE
24 S GMRASP(1)=5,GMRAHDR(1)="MECHANISM: ",GMRALIN(1)=$S($P(GMRAPA(0),U,14)="A":"ALLERGY",$P(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$P(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")
25 D WRITE Q:GMRAOUT
26SEVERE ;
27 I $P(GMRAPA(0),U,16)'=1 G ERROR
28 S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
29 S GMRASP(1)=6,GMRAHDR(1)="VERIFIER: "
30 S GMRALIN(1)=$S($P(GMRAPA(0),U,18)="":"",$D(^VA(200,+$P(GMRAPA(0),U,18),0)):$P(^(0),U),1:"") I GMRALIN(1)="",$P(GMRAPA(0),U,16)=1 S GMRALIN(1)="AUTOVERIFIED"
31 S GMRASP(2)=48,GMRAHDR(2)="VERIFIED: ",Y=$P(GMRAPA(0),U,17) D:Y D^DIQ S GMRALIN(2)=Y
32 D WRITE G:GMRAOUT EXIT
33 I ($Y+4)>IOSL D EOP G:GMRAOUT EXIT
34 D DISP1^GMRAPEM1(GMRAPA,"V",.GMRAOUT) G:GMRAOUT EXIT
35ERROR ;
36 G:'GMRAERR EXIT
37 S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
38 S GMRASP(1)=1,GMRAHDR(1)="USER ENTERING",GMRALIN(1)="",GMRASP(2)=45,GMRAHDR(2)="D/T ENTERED",GMRALIN(2)="" D WRITE Q:GMRAOUT
39 S GMRASP(1)=6,GMRAHDR(1)="IN ERROR: ",GMRANAME=$S($D(^GMR(120.8,GMRAPA,"ER")):$P(^("ER"),U,3),1:"")
40 S GMRALIN(1)=$S(GMRANAME="":"",$D(^VA(200,+GMRANAME,0)):$P(^(0),U),1:"")
41 S GMRASP(2)=48,GMRAHDR(2)="IN ERROR: ",Y=$S($D(^GMR(120.8,GMRAPA,"ER")):$P(^("ER"),U,2),1:"") D:Y D^DIQ S GMRALIN(2)=Y D WRITE Q:GMRAOUT
42 I ($Y+4)>IOSL D EOP G:GMRAOUT EXIT
43 D DISP1^GMRAPEM1(GMRAPA,"E",.GMRAOUT) G:GMRAOUT EXIT
44EXIT ;
45 I $G(GMRAPRNT) S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
46 I $G(GMRAPRNT),$O(GMRARRAY(GMRAAL))'=""!($O(GMRARRAY(GMRAAL,GMRAPA))'="") S GMRASP(1)=3,GMRAHDR(1)="",GMRALIN(1)="",$P(GMRALIN(1),"-",21)="",GMRASP(2)="" D WRITE Q:GMRAOUT
47 Q
48WRITE ; WRITE THE NEXT LINE OF THE REPORT
49 S GMRAFT=0 W:GMRASP(1)'=""!GMRASP(2)'="" ! F X=1:1:2 W:GMRASP(X)'="" ?GMRASP(X),GMRAHDR(X),GMRALIN(X)
50 Q:$Y+3'>IOSL
51EOP ; END OF PAGE
52 D ENDPG Q:GMRAOUT
53HDR ; PRINT HEADER FOR REPORT
54 I $E(IOST)="C" W @IOF
55 E W:GMRAPG @IOF
56 I $G(GMRAPG)'="" S GMRAPG=GMRAPG+1
57 S GMRAFT=1
58 F X=0:0 S X=$O(GMRAHEAD(X)) Q:X'>0 W !,GMRAHEAD(X)
59 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
60 Q
61ENDPG ;HANDLE EOP
62 I $E(IOST)="C" D Q:GMRAOUT
63 .K DIR S DIR(0)="E" D ^DIR K DIR
64 .S:'+Y GMRAOUT=1
65 .Q
66 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
67 Q
Note: See TracBrowser for help on using the repository browser.