GMRADSP3 ;HIRMFO/YMP,RM,WAA-PRINT PATIENT A/AR ;14-Jan-2011 09:54;MGH
;;4.0;Adverse Reaction Tracking;**1002**;Mar 29, 1996;Build 32
;IHS/MSC/MGH Updated for source of allergies
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_")"
.;IHS/MSC/MGH Data for source
.N X
.I $D(^GMR(120.8,GMRAPA,10,GMRAREA,9999999.11)) D
..S GMRAS=$P($G(^GMR(120.8,GMRAPA,10,GMRAREA,9999999.11)),U,1)
..S GMRAS=$$GET1^DIQ(90460.05,GMRAS,.01)
..I GMRAS'="" S GMRASP(2)=50,GMRAHDR(2)="SOURCE: ",GMRALIN(2)=GMRAS
.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
GMRADSP3 ;HIRMFO/YMP,RM,WAA-PRINT PATIENT A/AR ;14-Jan-2011 09:54;MGH
+1 ;;4.0;Adverse Reaction Tracking;**1002**;Mar 29, 1996;Build 32
+2 ;IHS/MSC/MGH Updated for source of allergies
EN1 ;
+1 IF '$DATA(GMRAOTH)
SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
+2 SET GMRASP(1)=""
SET GMRASP(2)=""
DO WRITE
IF GMRAOUT
QUIT
+3 SET GMRAREA=0
SET GMRAFT=1
+4 IF $GET(GMRAVFY,0)
SET GMRAHDR(1)=" SIGNS/SYMPTOMS: "
SET GMRASP(1)=0
+5 IF '$TEST
SET GMRAHDR(1)="SIGNS/SYMPTOMS: "
SET GMRASP(1)=0
+6 FOR
SET GMRAREA=$ORDER(^GMR(120.8,GMRAPA,10,GMRAREA))
IF GMRAREA<1
QUIT
Begin DoDot:1
+7 NEW GMRAX,GMRAZ
+8 SET GMRAX=$GET(^GMR(120.8,GMRAPA,10,GMRAREA,0))
+9 IF GMRAX=""
QUIT
+10 IF +GMRAX'=GMRAOTH
SET GMRALIN(1)=$EXTRACT($SELECT($DATA(^GMRD(120.83,+GMRAX,0)):$PIECE(^(0),U),1:""),1,23)
+11 IF '$TEST
SET GMRALIN(1)=$PIECE(GMRAX,U,2)
+12 SET GMRAZ=$SELECT($PIECE(GMRAX,U,4)'="":$$FMTE^XLFDT($PIECE(GMRAX,U,4),1),1:"")
+13 IF GMRAZ'=""
SET GMRALIN(1)=GMRALIN(1)_" ("_GMRAZ_")"
+14 ;IHS/MSC/MGH Data for source
+15 NEW X
+16 IF $DATA(^GMR(120.8,GMRAPA,10,GMRAREA,9999999.11))
Begin DoDot:2
+17 SET GMRAS=$PIECE($GET(^GMR(120.8,GMRAPA,10,GMRAREA,9999999.11)),U,1)
+18 SET GMRAS=$$GET1^DIQ(90460.05,GMRAS,.01)
+19 IF GMRAS'=""
SET GMRASP(2)=50
SET GMRAHDR(2)="SOURCE: "
SET GMRALIN(2)=GMRAS
End DoDot:2
+20 IF $GET(GMRAVFY,0)
IF GMRAHDR(1)=""
SET GMRALIN(1)=" "_GMRALIN(1)
+21 DO WRITE
SET GMRASP(1)=16
SET GMRAHDR(1)=""
+22 QUIT
End DoDot:1
IF GMRAOUT
QUIT
+23 ; Indicates this routine was run from verify part ART
IF $GET(GMRAVFY,0)
QUIT
ENDING ;
+1 SET (GMRASP(1),GMRASP(2))=""
DO WRITE
IF GMRAOUT
QUIT
+2 IF $PIECE(GMRAPA(0),U,14)=""
GOTO SEVERE
+3 SET GMRASP(1)=5
SET GMRAHDR(1)="MECHANISM: "
SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),U,14)="A":"ALLERGY",$PIECE(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$PIECE(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")
+4 DO WRITE
IF GMRAOUT
QUIT
SEVERE ;
+1 IF $PIECE(GMRAPA(0),U,16)'=1
GOTO ERROR
+2 SET (GMRASP(1),GMRASP(2))=""
DO WRITE
IF GMRAOUT
QUIT
+3 SET GMRASP(1)=6
SET GMRAHDR(1)="VERIFIER: "
+4 SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),U,18)="":"",$DATA(^VA(200,+$PIECE(GMRAPA(0),U,18),0)):$PIECE(^(0),U),1:"")
IF GMRALIN(1)=""
IF $PIECE(GMRAPA(0),U,16)=1
SET GMRALIN(1)="AUTOVERIFIED"
+5 SET GMRASP(2)=48
SET GMRAHDR(2)="VERIFIED: "
SET Y=$PIECE(GMRAPA(0),U,17)
IF Y
DO D^DIQ
SET GMRALIN(2)=Y
+6 DO WRITE
IF GMRAOUT
GOTO EXIT
+7 IF ($Y+4)>IOSL
DO EOP
IF GMRAOUT
GOTO EXIT
+8 DO DISP1^GMRAPEM1(GMRAPA,"V",.GMRAOUT)
IF GMRAOUT
GOTO EXIT
ERROR ;
+1 IF 'GMRAERR
GOTO EXIT
+2 SET (GMRASP(1),GMRASP(2))=""
DO WRITE
IF GMRAOUT
QUIT
+3 SET GMRASP(1)=1
SET GMRAHDR(1)="USER ENTERING"
SET GMRALIN(1)=""
SET GMRASP(2)=45
SET GMRAHDR(2)="D/T ENTERED"
SET GMRALIN(2)=""
DO WRITE
IF GMRAOUT
QUIT
+4 SET GMRASP(1)=6
SET GMRAHDR(1)="IN ERROR: "
SET GMRANAME=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):$PIECE(^("ER"),U,3),1:"")
+5 SET GMRALIN(1)=$SELECT(GMRANAME="":"",$DATA(^VA(200,+GMRANAME,0)):$PIECE(^(0),U),1:"")
+6 SET GMRASP(2)=48
SET GMRAHDR(2)="IN ERROR: "
SET Y=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):$PIECE(^("ER"),U,2),1:"")
IF Y
DO D^DIQ
SET GMRALIN(2)=Y
DO WRITE
IF GMRAOUT
QUIT
+7 IF ($Y+4)>IOSL
DO EOP
IF GMRAOUT
GOTO EXIT
+8 DO DISP1^GMRAPEM1(GMRAPA,"E",.GMRAOUT)
IF GMRAOUT
GOTO EXIT
EXIT ;
+1 IF $GET(GMRAPRNT)
SET (GMRASP(1),GMRASP(2))=""
DO WRITE
IF GMRAOUT
QUIT
+2 IF $GET(GMRAPRNT)
IF $ORDER(GMRARRAY(GMRAAL))'=""!($ORDER(GMRARRAY(GMRAAL,GMRAPA))'="")
SET GMRASP(1)=3
SET GMRAHDR(1)=""
SET GMRALIN(1)=""
SET $PIECE(GMRALIN(1),"-",21)=""
SET GMRASP(2)=""
DO WRITE
IF GMRAOUT
QUIT
+3 QUIT
WRITE ; WRITE THE NEXT LINE OF THE REPORT
+1 SET GMRAFT=0
IF GMRASP(1)'=""!GMRASP(2)'=""
WRITE !
FOR X=1:1:2
IF GMRASP(X)'=""
WRITE ?GMRASP(X),GMRAHDR(X),GMRALIN(X)
+2 IF $Y+3'>IOSL
QUIT
EOP ; END OF PAGE
+1 DO ENDPG
IF GMRAOUT
QUIT
HDR ; PRINT HEADER FOR REPORT
+1 IF $EXTRACT(IOST)="C"
WRITE @IOF
+2 IF '$TEST
IF GMRAPG
WRITE @IOF
+3 IF $GET(GMRAPG)'=""
SET GMRAPG=GMRAPG+1
+4 SET GMRAFT=1
+5 FOR X=0:0
SET X=$ORDER(GMRAHEAD(X))
IF X'>0
QUIT
WRITE !,GMRAHEAD(X)
+6 ; Check if stopped by user
IF $DATA(ZTQUEUED)
IF $$STPCK^GMRAUTL1
SET GMRAOUT=1
+7 QUIT
ENDPG ;HANDLE EOP
+1 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF '+Y
SET GMRAOUT=1
+4 QUIT
End DoDot:1
IF GMRAOUT
QUIT
+5 ; Check if stopped by user
IF $DATA(ZTQUEUED)
IF $$STPCK^GMRAUTL1
SET GMRAOUT=1
+6 QUIT
