source: FOIAVistA/tag/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP3.m@ 628

GMRADSP3 ;HIRMFO/YMP,RM,WAA-PRINT PATIENT A/AR ; 8/16/92
 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ;
 S:'$D(GMRAOTH) GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
 S GMRASP(1)="",GMRASP(2)="" D WRITE Q:GMRAOUT
 S GMRAREA=0,GMRAFT=1
 I $G(GMRAVFY,0) S GMRAHDR(1)=" SIGNS/SYMPTOMS: ",GMRASP(1)=0
 E  S GMRAHDR(1)="SIGNS/SYMPTOMS: ",GMRASP(1)=0
 F  S GMRAREA=$O(^GMR(120.8,GMRAPA,10,GMRAREA)) Q:GMRAREA<1  D  Q:GMRAOUT
 .N GMRAX,GMRAZ
 .S GMRAX=$G(^GMR(120.8,GMRAPA,10,GMRAREA,0))
 .Q:GMRAX=""
 .I +GMRAX'=GMRAOTH S GMRALIN(1)=$E($S($D(^GMRD(120.83,+GMRAX,0)):$P(^(0),U),1:""),1,23)
 .E  S GMRALIN(1)=$P(GMRAX,U,2)
 .S GMRAZ=$S($P(GMRAX,U,4)'="":$$FMTE^XLFDT($P(GMRAX,U,4),1),1:"")
 .S:GMRAZ'="" GMRALIN(1)=GMRALIN(1)_"  ("_GMRAZ_")"
 .I $G(GMRAVFY,0),GMRAHDR(1)="" S GMRALIN(1)=" "_GMRALIN(1)
 .D WRITE S GMRASP(1)=16,GMRAHDR(1)=""
 .Q
 Q:$G(GMRAVFY,0)  ; Indicates this routine was run from verify part ART
ENDING ;
 S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
 G:$P(GMRAPA(0),U,14)="" SEVERE
 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:"")
 D WRITE Q:GMRAOUT
SEVERE ;
 I $P(GMRAPA(0),U,16)'=1 G ERROR
 S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
 S GMRASP(1)=6,GMRAHDR(1)="VERIFIER: "
 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"
 S GMRASP(2)=48,GMRAHDR(2)="VERIFIED: ",Y=$P(GMRAPA(0),U,17) D:Y D^DIQ S GMRALIN(2)=Y
 D WRITE G:GMRAOUT EXIT
 I ($Y+4)>IOSL D EOP G:GMRAOUT EXIT
 D DISP1^GMRAPEM1(GMRAPA,"V",.GMRAOUT) G:GMRAOUT EXIT
ERROR ;
 G:'GMRAERR EXIT
 S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
 S GMRASP(1)=1,GMRAHDR(1)="USER ENTERING",GMRALIN(1)="",GMRASP(2)=45,GMRAHDR(2)="D/T ENTERED",GMRALIN(2)="" D WRITE Q:GMRAOUT
 S GMRASP(1)=6,GMRAHDR(1)="IN ERROR: ",GMRANAME=$S($D(^GMR(120.8,GMRAPA,"ER")):$P(^("ER"),U,3),1:"")
 S GMRALIN(1)=$S(GMRANAME="":"",$D(^VA(200,+GMRANAME,0)):$P(^(0),U),1:"")
 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
 I ($Y+4)>IOSL D EOP G:GMRAOUT EXIT
 D DISP1^GMRAPEM1(GMRAPA,"E",.GMRAOUT) G:GMRAOUT EXIT
EXIT ;
 I $G(GMRAPRNT) S (GMRASP(1),GMRASP(2))="" D WRITE Q:GMRAOUT
 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
 Q
WRITE ; WRITE THE NEXT LINE OF THE REPORT
 S GMRAFT=0 W:GMRASP(1)'=""!GMRASP(2)'="" ! F X=1:1:2 W:GMRASP(X)'="" ?GMRASP(X),GMRAHDR(X),GMRALIN(X)
 Q:$Y+3'>IOSL
EOP ; END OF PAGE
 D ENDPG Q:GMRAOUT
HDR ; PRINT HEADER FOR REPORT
 I $E(IOST)="C" W @IOF
 E  W:GMRAPG @IOF
 I $G(GMRAPG)'="" S GMRAPG=GMRAPG+1
 S GMRAFT=1
 F X=0:0 S X=$O(GMRAHEAD(X)) Q:X'>0  W !,GMRAHEAD(X)
 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
 Q
ENDPG ;HANDLE EOP
 I $E(IOST)="C" D  Q:GMRAOUT
 .K DIR S DIR(0)="E" D ^DIR K DIR
 .S:'+Y GMRAOUT=1
 .Q
 I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
 Q