GMRADSP2 ;HIRMFO/RM,WAA-PRINT PATIENT A/AR ;01-May-2012 14:15;DU
;;4.0;Adverse Reaction Tracking;**21,1002,1006**;Mar 29, 1996;Build 29
;IHS/MSC/MGH added data for source patch 1002,1006
EN1 ; ENTRY TO PRINT DATA FOR A SINGLE RECORD DENOTED BY GMRAPA
S GMRAOUT=0
S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
;IHS/MSC/MGH added back patch 1006
S GMRAPA(9999999.11)=$S($D(^GMR(120.8,GMRAPA,9999999.11)):^(9999999.11),1:"")
S DFN=$P(GMRAPA(0),"^") D DEM^VADPT S GMRANAM=VADM(1) D KVAR^VADPT K VA
S GMRADRUG=$S($P(GMRAPA(0),U,20)["D":1,1:0)
S GMRAERR=$S($D(^GMR(120.8,GMRAPA,"ER")):+^("ER"),1:0) S:'$D(GMRAPG) GMRAPG=0
D:$Y+3>IOSL EOP^GMRADSP3 G:GMRAOUT EXIT
;D:'GMRAPG HDR^GMRADSP3
I 'GMRAPRNT S GMRASP(1)=7,GMRAHDR(1)="PATIENT: ",GMRALIN(1)=$E(GMRANAM,1,23),GMRASP(2)=41,GMRAHDR(2)="CAUSATIVE AGENT: ",GMRALIN(2)=$E($P(GMRAPA(0),"^",2),1,21) D WRITE^GMRADSP3 G:GMRAOUT EXIT ;21
I GMRAPRNT S GMRASP(1)=9,GMRAHDR(1)="AGENT: ",GMRALIN(1)=$E($P(GMRAPA(0),"^",2),1,23),GMRASP(2)="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
G:'GMRADRUG ORIG S (GMRADI,GMRADC)=0,GMRAFT=1
DICL ;
S:GMRADI'="" GMRADI=$O(^GMR(120.8,GMRAPA,2,GMRADI)) S:GMRADC'="" GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) G:GMRADI'>0&(GMRADC'>0)&'GMRAFT ORIG
S GMRASP(1)=$S(GMRAFT:3,'GMRADI:"",1:16),GMRAHDR(1)=$S(GMRAFT:"INGREDIENTS: ",1:""),X=$S($D(^GMR(120.8,GMRAPA,2,+GMRADI,0)):^(0),1:""),GMRALIN(1)=$E($S($D(^PS(50.416,+X,0)):$P(^(0),"^"),1:""),1,23)
S GMRASP(2)=$S(GMRAFT:41,'GMRADC:"",1:58),GMRAHDR(2)=$S(GMRAFT:"VA DRUG CLASSES: ",1:""),X=$S($D(^GMR(120.8,GMRAPA,3,+GMRADC,0)):^(0),1:""),GMRALIN(2)=$E($S($D(^PS(50.605,+X,0)):$P(^(0),"^",2),1:""),1,21)
D WRITE^GMRADSP3 G:GMRAOUT EXIT S GMRAFT=0 G DICL
ORIG ;
S GMRAREA=0,GMRATRT=0
S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
;IHS/MSC/MGH added back patch 1006
I $P($G(^GMR(120.8,GMRAPA,9999999.11)),U,1)'="" D
.S GMRASP(1)=6,GMRAHDR(1)="SOURCE OF INFORMATION: ",GMRALIN(1)=$$GET1^DIQ(120.8,GMRAPA,9999999.11)
.D WRITE^GMRADSP3 G:GMRAOUT EXIT
;end mod
S Y=$P(GMRAPA(0),"^",4) S:Y Y=$$FMTE^XLFDT(Y) S GMRASP(1)=4,GMRAHDR(1)="ORIGINATOR: ",GMRALIN(1)=$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01") ;21
S GMRASP(2)=46,GMRAHDR(2)="ORIGINATED: ",GMRALIN(2)=Y D WRITE^GMRADSP3 G:GMRAOUT EXIT
S GMRASP(1)=6,GMRAHDR(1)="SIGN OFF: ",GMRALIN(1)=$S($P(GMRAPA(0),"^",12)=1:"YES",1:"NO"),GMRASP(2)=48,GMRAHDR(2)="OBS/HIST: ",GMRALIN(2)=$S($P(GMRAPA(0),"^",6)="o":"OBSERVED",$P(GMRAPA(0),"^",6)="h":"HISTORICAL",1:"")
D WRITE^GMRADSP3 G:GMRAOUT EXIT
;IHS/MSC/MGH Mod added back patch 1006
;Printout the SNOMED event IHS/MSC/MGH
S GMRSNO=$P(GMRAPA(9999999.11),"^",2)
I +GMRSNO D
.S SNOTXT=$P($G(^BEHOAR(90460.06,GMRSNO,0)),U,1),SNOCODE=$P($G(^BEHOAR(90460.06,GMRSNO,0)),U,2)
.S GMRASP(1)=6,GMRAHDR(1)="EVENT: ",GMRALIN(1)=SNOTXT
.S GNRASP(2)=46,GMRAHDR(2)="CODE: ",GMRALIN(2)=SNOCODE D WRITE^GMRADSP3
.G:GMRAOUT EXIT
.;end mod
I $D(^GMR(120.85,"C",GMRAPA)) D ;21
.S (GMRASP(1),GMRASP(2))="" ;21
.N GMRAI,SEVER S (GMRAI,SEVER)=0 F S GMRAI=$O(^GMR(120.85,"C",GMRAPA,GMRAI)) Q:'+GMRAI S:+$P(^GMR(120.85,GMRAI,0),U,14)>SEVER SEVER=$P(^(0),U,14) ;21
.I $G(SEVER) S GMRASP(1)=6,GMRAHDR(1)="SEVERITY: ",GMRALIN(1)=$S(SEVER=1:"MILD",SEVER=2:"MODERATE",1:"SEVERE") ;21
.S GMRASP(2)=49,GMRAHDR(2)="OBS D/T: ",GMRALIN(2)=$$FMTE^XLFDT($P(^GMR(120.85,$O(^GMR(120.85,"C",GMRAPA,0)),0),U)) ;21
.D WRITE^GMRADSP3 G:GMRAOUT EXIT ;21
.Q ;21
I ($Y+4)>IOSL D EOP^GMRADSP3 G:GMRAOUT EXIT
D DISP1^GMRAPEM1(GMRAPA,"O",.GMRAOUT) G:GMRAOUT EXIT
S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
S GMRASP(1)=0,GMRAHDR(1)="ID BAND MARKED: ",Y="",Y=$O(^GMR(120.8,GMRAPA,14,"A",Y)),Y=9999999-Y S:Y'=9999999 Y=$$FMTE^XLFDT(Y) S:Y=9999999 Y="" ;21
S GMRASP(2)=44,GMRALIN(1)=Y,GMRAHDR(2)="CHART MARKED: ",Y="",Y=$O(^GMR(120.8,GMRAPA,13,"A",Y)),Y=9999999-Y S:Y'=9999999 Y=$$FMTE^XLFDT(Y) S:Y=9999999 Y="" S GMRALIN(2)=Y ;21
D WRITE^GMRADSP3 G:GMRAOUT EXIT
;IHS/MSC/MGH mods returned patch 1006
I $D(GMRAIN)>0 D
.S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT
.N X,X2,X3,X4,X5,Z,IIEN
.S Z=9999999 S Z=$O(^GMR(120.8,GMRAPA,9999999.12,Z),-1) I +Z D
..S IIEN=Z_","_GMRAPA_","
..S X=$$GET1^DIQ(120.899999912,IIEN,.01),X2=$$GET1^DIQ(120.899999912,IIEN,1),X3=$$GET1^DIQ(120.899999912,IIEN,2)
..S X4=$$GET1^DIQ(120.899999912,IIEN,3),X5=$$GET1^DIQ(120.899999912,IIEN,4)
..S GMRASP(1)=0,GMRAHDR(1)="INACTIVE: ",GMRALIN(1)=X
..D WRITE^GMRADSP3 G:GMRAOUT EXIT
..S GMRASP(1)=6,GMRAHDR(1)="REASON: ",GMRALIN(1)=X2
..S GMRASP(2)=40,GMRAHDR(2)="BY: ",GMRALIN(2)=X3
..D WRITE^GMRADSP3 G:GMRAOUT EXIT
..I X4'="" D
...S GMRASP(1)=0,GMRAHDR(1)="REACTIVATION: ",GMRALIN(1)=X4
...S GMRASP(2)=30,GMRAHDR(2)="BY: ",GMRALIN(2)=X5
...D WRITE^GMRADSP3 G:GMRAOUT EXIT
G RESET
LINEOUT ;
S GMRASP(1)=$S(GMRAFT:6,1:16),GMRAHDR(1)=$S(GMRAFT:"COMMENTS: ",1:""),GMRALIN(1)=$S($D(^UTILITY($J,"W",15,+GMRAX,0)):^(0),1:""),GMRASP(2)="" D WRITE^GMRADSP3 G:GMRAOUT EXIT S GMRAFT=0
Q
RESET ;
D ^GMRADSP3
EXIT K DIWF,DIWL,DIWR,GMRA,GMRADC,GMRADI,GMRAHDR,GMRSN0,GMRALIN,GMRASP,GMRAFT,GMRAREA,GMRATRT,GMRAX,SNOTXT,SNOCODE
Q
GMRADSP2 ;HIRMFO/RM,WAA-PRINT PATIENT A/AR ;01-May-2012 14:15;DU
+1 ;;4.0;Adverse Reaction Tracking;**21,1002,1006**;Mar 29, 1996;Build 29
+2 ;IHS/MSC/MGH added data for source patch 1002,1006
EN1 ; ENTRY TO PRINT DATA FOR A SINGLE RECORD DENOTED BY GMRAPA
+1 SET GMRAOUT=0
+2 SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
+3 ;IHS/MSC/MGH added back patch 1006
+4 SET GMRAPA(9999999.11)=$SELECT($DATA(^GMR(120.8,GMRAPA,9999999.11)):^(9999999.11),1:"")
+5 SET DFN=$PIECE(GMRAPA(0),"^")
DO DEM^VADPT
SET GMRANAM=VADM(1)
DO KVAR^VADPT
KILL VA
+6 SET GMRADRUG=$SELECT($PIECE(GMRAPA(0),U,20)["D":1,1:0)
+7 SET GMRAERR=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):+^("ER"),1:0)
IF '$DATA(GMRAPG)
SET GMRAPG=0
+8 IF $Y+3>IOSL
DO EOP^GMRADSP3
IF GMRAOUT
GOTO EXIT
+9 ;D:'GMRAPG HDR^GMRADSP3
+10 ;21
IF 'GMRAPRNT
SET GMRASP(1)=7
SET GMRAHDR(1)="PATIENT: "
SET GMRALIN(1)=$EXTRACT(GMRANAM,1,23)
SET GMRASP(2)=41
SET GMRAHDR(2)="CAUSATIVE AGENT: "
SET GMRALIN(2)=$EXTRACT($PIECE(GMRAPA(0),"^",2),1,21)
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+11 IF GMRAPRNT
SET GMRASP(1)=9
SET GMRAHDR(1)="AGENT: "
SET GMRALIN(1)=$EXTRACT($PIECE(GMRAPA(0),"^",2),1,23)
SET GMRASP(2)=""
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+12 IF 'GMRADRUG
GOTO ORIG
SET (GMRADI,GMRADC)=0
SET GMRAFT=1
DICL ;
+1 IF GMRADI'=""
SET GMRADI=$ORDER(^GMR(120.8,GMRAPA,2,GMRADI))
IF GMRADC'=""
SET GMRADC=$ORDER(^GMR(120.8,GMRAPA,3,GMRADC))
IF GMRADI'>0&(GMRADC'>0)&'GMRAFT
GOTO ORIG
+2 SET GMRASP(1)=$SELECT(GMRAFT:3,'GMRADI:"",1:16)
SET GMRAHDR(1)=$SELECT(GMRAFT:"INGREDIENTS: ",1:"")
SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,2,+GMRADI,0)):^(0),1:"")
SET GMRALIN(1)=$EXTRACT($SELECT($DATA(^PS(50.416,+X,0)):$PIECE(^(0),"^"),1:""),1,23)
+3 SET GMRASP(2)=$SELECT(GMRAFT:41,'GMRADC:"",1:58)
SET GMRAHDR(2)=$SELECT(GMRAFT:"VA DRUG CLASSES: ",1:"")
SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,3,+GMRADC,0)):^(0),1:"")
SET GMRALIN(2)=$EXTRACT($SELECT($DATA(^PS(50.605,+X,0)):$PIECE(^(0),"^",2),1:""),1,21)
+4 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
SET GMRAFT=0
GOTO DICL
ORIG ;
+1 SET GMRAREA=0
SET GMRATRT=0
+2 SET (GMRASP(1),GMRASP(2))=""
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+3 ;IHS/MSC/MGH added back patch 1006
+4 IF $PIECE($GET(^GMR(120.8,GMRAPA,9999999.11)),U,1)'=""
Begin DoDot:1
+5 SET GMRASP(1)=6
SET GMRAHDR(1)="SOURCE OF INFORMATION: "
SET GMRALIN(1)=$$GET1^DIQ(120.8,GMRAPA,9999999.11)
+6 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
End DoDot:1
+7 ;end mod
+8 ;21
SET Y=$PIECE(GMRAPA(0),"^",4)
IF Y
SET Y=$$FMTE^XLFDT(Y)
SET GMRASP(1)=4
SET GMRAHDR(1)="ORIGINATOR: "
SET GMRALIN(1)=$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",",".01")
+9 SET GMRASP(2)=46
SET GMRAHDR(2)="ORIGINATED: "
SET GMRALIN(2)=Y
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+10 SET GMRASP(1)=6
SET GMRAHDR(1)="SIGN OFF: "
SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),"^",12)=1:"YES",1:"NO")
SET GMRASP(2)=48
SET GMRAHDR(2)="OBS/HIST: "
SET GMRALIN(2)=$SELECT($PIECE(GMRAPA(0),"^",6)="o":"OBSERVED",$PIECE(GMRAPA(0),"^",6)="h":"HISTORICAL",1:"")
+11 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+12 ;IHS/MSC/MGH Mod added back patch 1006
+13 ;Printout the SNOMED event IHS/MSC/MGH
+14 SET GMRSNO=$PIECE(GMRAPA(9999999.11),"^",2)
+15 IF +GMRSNO
Begin DoDot:1
+16 SET SNOTXT=$PIECE($GET(^BEHOAR(90460.06,GMRSNO,0)),U,1)
SET SNOCODE=$PIECE($GET(^BEHOAR(90460.06,GMRSNO,0)),U,2)
+17 SET GMRASP(1)=6
SET GMRAHDR(1)="EVENT: "
SET GMRALIN(1)=SNOTXT
+18 SET GNRASP(2)=46
SET GMRAHDR(2)="CODE: "
SET GMRALIN(2)=SNOCODE
DO WRITE^GMRADSP3
+19 IF GMRAOUT
GOTO EXIT
+20 ;end mod
End DoDot:1
+21 ;21
IF $DATA(^GMR(120.85,"C",GMRAPA))
Begin DoDot:1
+22 ;21
SET (GMRASP(1),GMRASP(2))=""
+23 ;21
NEW GMRAI,SEVER
SET (GMRAI,SEVER)=0
FOR
SET GMRAI=$ORDER(^GMR(120.85,"C",GMRAPA,GMRAI))
IF '+GMRAI
QUIT
IF +$PIECE(^GMR(120.85,GMRAI,0),U,14)>SEVER
SET SEVER=$PIECE(^(0),U,14)
+24 ;21
IF $GET(SEVER)
SET GMRASP(1)=6
SET GMRAHDR(1)="SEVERITY: "
SET GMRALIN(1)=$SELECT(SEVER=1:"MILD",SEVER=2:"MODERATE",1:"SEVERE")
+25 ;21
SET GMRASP(2)=49
SET GMRAHDR(2)="OBS D/T: "
SET GMRALIN(2)=$$FMTE^XLFDT($PIECE(^GMR(120.85,$ORDER(^GMR(120.85,"C",GMRAPA,0)),0),U))
+26 ;21
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+27 ;21
QUIT
End DoDot:1
+28 IF ($Y+4)>IOSL
DO EOP^GMRADSP3
IF GMRAOUT
GOTO EXIT
+29 DO DISP1^GMRAPEM1(GMRAPA,"O",.GMRAOUT)
IF GMRAOUT
GOTO EXIT
+30 SET (GMRASP(1),GMRASP(2))=""
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+31 ;21
SET GMRASP(1)=0
SET GMRAHDR(1)="ID BAND MARKED: "
SET Y=""
SET Y=$ORDER(^GMR(120.8,GMRAPA,14,"A",Y))
SET Y=9999999-Y
IF Y'=9999999
SET Y=$$FMTE^XLFDT(Y)
IF Y=9999999
SET Y=""
+32 ;21
SET GMRASP(2)=44
SET GMRALIN(1)=Y
SET GMRAHDR(2)="CHART MARKED: "
SET Y=""
SET Y=$ORDER(^GMR(120.8,GMRAPA,13,"A",Y))
SET Y=9999999-Y
IF Y'=9999999
SET Y=$$FMTE^XLFDT(Y)
IF Y=9999999
SET Y=""
SET GMRALIN(2)=Y
+33 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+34 ;IHS/MSC/MGH mods returned patch 1006
+35 IF $DATA(GMRAIN)>0
Begin DoDot:1
+36 SET (GMRASP(1),GMRASP(2))=""
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+37 NEW X,X2,X3,X4,X5,Z,IIEN
+38 SET Z=9999999
SET Z=$ORDER(^GMR(120.8,GMRAPA,9999999.12,Z),-1)
IF +Z
Begin DoDot:2
+39 SET IIEN=Z_","_GMRAPA_","
+40 SET X=$$GET1^DIQ(120.899999912,IIEN,.01)
SET X2=$$GET1^DIQ(120.899999912,IIEN,1)
SET X3=$$GET1^DIQ(120.899999912,IIEN,2)
+41 SET X4=$$GET1^DIQ(120.899999912,IIEN,3)
SET X5=$$GET1^DIQ(120.899999912,IIEN,4)
+42 SET GMRASP(1)=0
SET GMRAHDR(1)="INACTIVE: "
SET GMRALIN(1)=X
+43 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+44 SET GMRASP(1)=6
SET GMRAHDR(1)="REASON: "
SET GMRALIN(1)=X2
+45 SET GMRASP(2)=40
SET GMRAHDR(2)="BY: "
SET GMRALIN(2)=X3
+46 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
+47 IF X4'=""
Begin DoDot:3
+48 SET GMRASP(1)=0
SET GMRAHDR(1)="REACTIVATION: "
SET GMRALIN(1)=X4
+49 SET GMRASP(2)=30
SET GMRAHDR(2)="BY: "
SET GMRALIN(2)=X5
+50 DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
End DoDot:3
End DoDot:2
End DoDot:1
+51 GOTO RESET
LINEOUT ;
+1 SET GMRASP(1)=$SELECT(GMRAFT:6,1:16)
SET GMRAHDR(1)=$SELECT(GMRAFT:"COMMENTS: ",1:"")
SET GMRALIN(1)=$SELECT($DATA(^UTILITY($JOB,"W",15,+GMRAX,0)):^(0),1:"")
SET GMRASP(2)=""
DO WRITE^GMRADSP3
IF GMRAOUT
GOTO EXIT
SET GMRAFT=0
+2 QUIT
RESET ;
+1 DO ^GMRADSP3
EXIT KILL DIWF,DIWL,DIWR,GMRA,GMRADC,GMRADI,GMRAHDR,GMRSN0,GMRALIN,GMRASP,GMRAFT,GMRAREA,GMRATRT,GMRAX,SNOTXT,SNOCODE
+1 QUIT
