Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRADSP3

GMRADSP3.m

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