GMRAPER2 ;HIRMFO/WAA CENTRAL ENTRY FOR REACTIONS ;17-Aug-2011 14:49;DU
;;4.0;Adverse Reaction Tracking;**1002,1003**;Mar 29, 1996;Build 18
;IHS/MSC/MGH added source of information
EN1(GMRAIEN,GMRAFILE,GMRAOUT,GMRAODT) ; ENTRY TO EDIT THE OBSERVED A/AR DATA
; INPUT
; GMRAPIEN = THE INTERNAL ENTRY NUMBER FOR THE REACTION
; GMRAFILE = THE FILE NUMBER OF THE ENTRY IE 120.9 OR 120.85
; GMRAODT = THE OBSERVED DATE OF THE REACTION (OPTIONAL)
;OUTOUT
; GMRAOUT = IF 0 USER EXITED NORMALY
;
N DFN,GMRAOTH,GMRAX,GMRAY,GMRASITE,GMRANDT,GMRAREAC,GMRARECN
N GMRARPR,GMRACHC,GMRAR10,GMRAASK,GMRADATE
S GMRAODT=$G(GMRAODT)
; v--> define other entry
D SITE^GMRAUTL S GMRAY=GMRASITE ; Get site parameters
SITE ; v--> Load predefined sign and symptoms from SITE FILE
F GMRAX=1:1:10 D
.S X=$S($D(^GMRD(120.84,GMRAY,1,GMRAX,0)):$P(^(0),U),1:"")
.S Y=$S($D(^GMRD(120.83,+X,0)):^(0),1:""),GMRAR10(GMRAX)=$S(X'=""!(Y'=""):X_U_Y,1:"")
.Q
S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
;Process what file
I GMRAFILE=120.8 S GMRAND=10 D PAT
I GMRAFILE=120.85 S GMRAND=2 D ADR
D LOAD(GMRAIEN,GMRAFILE,GMRAND)
S GMRADATE="",GMRSRC=""
D EN1^GMRAPER0 G:GMRAOUT EXIT
N GMRAFLG S GMRAFLG=0
S:'$D(^GMR(GMRAFILE,GMRAIEN,GMRAND,0)) ^(0)=$S(GMRAFILE="120.8":"^120.81P^^",1:"^120.8502P^^")
; v--Add S/S that are in file 120.82
;IHS/MSC/MGH add source to reaction
F GMRAREC=0:0 S GMRAREC=$O(GMRARAD(GMRAREC)) Q:GMRAREC'>0 D
.S X=GMRAREC_"^^"_DUZ_U_$P(GMRARAD(GMRAREC),U,2)
.S X2=$P(GMRAWHO(GMRAREC),U,2) D ADREAC S GMRAFLG=1
; v--Add Other S/S Freetext
S GMRAREC="" F GMRAX=0:0 S GMRAREC=$O(GMRAROT(GMRAREC)) Q:GMRAREC="" S X=GMRAOTH_U_GMRAREC_U_DUZ_U_$P(GMRAROT(GMRAREC),U,2) D ADREAC S GMRAFLG=1
; v--Delete a S/S
S DA(1)=GMRAIEN,DIK="^GMR("_GMRAFILE_","_DA(1)_","_GMRAND_","
S GMRAREC=0 F S GMRAREC=$O(GMRARDL(GMRAREC)) Q:GMRAREC'>0 S DA=0 F S DA=$O(^GMR(GMRAFILE,DA(1),GMRAND,"B",GMRAREC,DA)) Q:DA<1 D ^DIK S GMRAFLG=1
; v--delete other S/S entries
S DA(1)=GMRAIEN,DIK="^GMR("_GMRAFILE_","_DA(1)_","_GMRAND_","
S GMRAREC="" F S GMRAREC=$O(GMRAROTD(GMRAREC)) Q:GMRAREC="" S DA=0 F S DA=$O(^GMR(GMRAFILE,DA(1),GMRAND,"B",GMRAOTH,DA)) Q:DA'>0 I $D(^GMR(GMRAFILE,DA(1),GMRAND,DA,0)),$P(^(0),U,2)=GMRAREC D ^DIK S GMRAFLG=1
I GMRAFLG D:GMRAFILE'=120.85 EN1^GMRAPTB
Q
ADREAC ; ADD ENTRY TO SIGNS/SYMPTOMS MULTIPLE
S GMRAZN=$P(^GMR(GMRAFILE,GMRAIEN,GMRAND,0),U,3,4),DA=$P(GMRAZN,U)+1 F DA=DA:1 Q:'$D(^GMR(GMRAFILE,GMRAIEN,GMRAND,DA,0))
S ^GMR(GMRAFILE,GMRAIEN,GMRAND,DA,0)=X
S DA(1)=GMRAIEN
S DIK="^GMR("_GMRAFILE_",DA(1),"_GMRAND_"," D IX1^DIK S $P(^GMR(GMRAFILE,GMRAIEN,GMRAND,0),U,3,4)=DA_U_($P(GMRAZN,U,2)+1)
;IHS/MSC/MGH Added source for reaction
I +X2 D
.S DIE="^GMR(120.8,GMRAIEN,GMRAND,"
.S DA(1)=GMRAIEN,DR="9999999.11///^S X=X2"
.D ^DIE
.K DIE,DR
Q
PAT ;This is to process entries in file 120.8 on the 10 mutli.
S GMRAPA=GMRAIEN
N DFN S DFN=$P($G(^GMR(120.8,GMRAPA,0)),U) I 'DFN W !,"BAD DATA CONTACT IRM",$C(7) S GMRAOUT=1 Q ; Validate entry
S GMRAPA(0)=^GMR(120.8,GMRAPA,0)
Q
ADR ;This is to load the data in 120.85 on the 2 Multi.
S GMRANDT=1
S GMRAPA1=GMRAIEN
S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) I GMRAPA1(0)="" W !,"BAD DATA CONTACT IRM",$C(7) S GMRAOUT=1 Q ; Validate entry
S GMRAPA=$P(GMRAPA1(0),U,15),GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) I GMRAPA="" W !,"BAD DATA CONTACT IRM",$C(7) S GMRAOUT=1 Q ; Validate entry
Q
LOAD(GMRAIEN,GMRAFILE,GMRAND) ;
;Load existing entries in the given file
;INPUT:
; GMRAIEN IS THE IEN OF THE FILE THAT IS BEING EDITED
; GMRAFILE IS THE FILE NUMBER
; GMRAND IS THE NODE MULTI
;OUTPUT
;
N X,Y,Z
S GMRAX=0 F S GMRAX=$O(^GMR(GMRAFILE,GMRAIEN,GMRAND,GMRAX)) Q:GMRAX<1 D
.S Y=$S($D(^GMR(GMRAFILE,GMRAIEN,GMRAND,GMRAX,0)):^(0),1:"")
.S X=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
.;Patch 1003 IHS/MSC/MGH
.I X'="",Y'="" D
..S GMRARPR(X,+Y)=X_U_$P(Y,U,3)_U_$P(Y,U,4)
..S Z=$S($D(^GMR(GMRAFILE,GMRAIEN,GMRAND,GMRAX,9999999.11)):^(9999999.11),1:"")
..I Z'="" S GMRARPR(X,+Y)=GMRARPR(X,+Y)_U_$P(Z,U,1)
.Q
Q
EXIT ;KILL CLEAN
Q
SOURCE() ;Get the source
N DA,DIC,DR,Y
S DIC=90460.05
S DIC(0)="AEMQ"
S DIC("S")="I $P(^(0),U,2)=""S"""
S DIC("A")="Select source: "
D ^DIC I $D(DIRUT) K DIRUT Q -1
Q Y
GMRAPER2 ;HIRMFO/WAA CENTRAL ENTRY FOR REACTIONS ;17-Aug-2011 14:49;DU
+1 ;;4.0;Adverse Reaction Tracking;**1002,1003**;Mar 29, 1996;Build 18
+2 ;IHS/MSC/MGH added source of information
EN1(GMRAIEN,GMRAFILE,GMRAOUT,GMRAODT) ; ENTRY TO EDIT THE OBSERVED A/AR DATA
+1 ; INPUT
+2 ; GMRAPIEN = THE INTERNAL ENTRY NUMBER FOR THE REACTION
+3 ; GMRAFILE = THE FILE NUMBER OF THE ENTRY IE 120.9 OR 120.85
+4 ; GMRAODT = THE OBSERVED DATE OF THE REACTION (OPTIONAL)
+5 ;OUTOUT
+6 ; GMRAOUT = IF 0 USER EXITED NORMALY
+7 ;
+8 NEW DFN,GMRAOTH,GMRAX,GMRAY,GMRASITE,GMRANDT,GMRAREAC,GMRARECN
+9 NEW GMRARPR,GMRACHC,GMRAR10,GMRAASK,GMRADATE
+10 SET GMRAODT=$GET(GMRAODT)
+11 ; v--> define other entry
+12 ; Get site parameters
DO SITE^GMRAUTL
SET GMRAY=GMRASITE
SITE ; v--> Load predefined sign and symptoms from SITE FILE
+1 FOR GMRAX=1:1:10
Begin DoDot:1
+2 SET X=$SELECT($DATA(^GMRD(120.84,GMRAY,1,GMRAX,0)):$PIECE(^(0),U),1:"")
+3 SET Y=$SELECT($DATA(^GMRD(120.83,+X,0)):^(0),1:"")
SET GMRAR10(GMRAX)=$SELECT(X'=""!(Y'=""):X_U_Y,1:"")
+4 QUIT
End DoDot:1
+5 SET GMRAOTH=$GET(GMRAOTH,$ORDER(^GMRD(120.83,"B","OTHER REACTION",0)))
+6 ;Process what file
+7 IF GMRAFILE=120.8
SET GMRAND=10
DO PAT
+8 IF GMRAFILE=120.85
SET GMRAND=2
DO ADR
+9 DO LOAD(GMRAIEN,GMRAFILE,GMRAND)
+10 SET GMRADATE=""
SET GMRSRC=""
+11 DO EN1^GMRAPER0
IF GMRAOUT
GOTO EXIT
+12 NEW GMRAFLG
SET GMRAFLG=0
+13 IF '$DATA(^GMR(GMRAFILE,GMRAIEN,GMRAND,0))
SET ^(0)=$SELECT(GMRAFILE="120.8":"^120.81P^^",1:"^120.8502P^^")
+14 ; v--Add S/S that are in file 120.82
+15 ;IHS/MSC/MGH add source to reaction
+16 FOR GMRAREC=0:0
SET GMRAREC=$ORDER(GMRARAD(GMRAREC))
IF GMRAREC'>0
QUIT
Begin DoDot:1
+17 SET X=GMRAREC_"^^"_DUZ_U_$PIECE(GMRARAD(GMRAREC),U,2)
+18 SET X2=$PIECE(GMRAWHO(GMRAREC),U,2)
DO ADREAC
SET GMRAFLG=1
End DoDot:1
+19 ; v--Add Other S/S Freetext
+20 SET GMRAREC=""
FOR GMRAX=0:0
SET GMRAREC=$ORDER(GMRAROT(GMRAREC))
IF GMRAREC=""
QUIT
SET X=GMRAOTH_U_GMRAREC_U_DUZ_U_$PIECE(GMRAROT(GMRAREC),U,2)
DO ADREAC
SET GMRAFLG=1
+21 ; v--Delete a S/S
+22 SET DA(1)=GMRAIEN
SET DIK="^GMR("_GMRAFILE_","_DA(1)_","_GMRAND_","
+23 SET GMRAREC=0
FOR
SET GMRAREC=$ORDER(GMRARDL(GMRAREC))
IF GMRAREC'>0
QUIT
SET DA=0
FOR
SET DA=$ORDER(^GMR(GMRAFILE,DA(1),GMRAND,"B",GMRAREC,DA))
IF DA<1
QUIT
DO ^DIK
SET GMRAFLG=1
+24 ; v--delete other S/S entries
+25 SET DA(1)=GMRAIEN
SET DIK="^GMR("_GMRAFILE_","_DA(1)_","_GMRAND_","
+26 SET GMRAREC=""
FOR
SET GMRAREC=$ORDER(GMRAROTD(GMRAREC))
IF GMRAREC=""
QUIT
SET DA=0
FOR
SET DA=$ORDER(^GMR(GMRAFILE,DA(1),GMRAND,"B",GMRAOTH,DA))
IF DA'>0
QUIT
IF $DATA(^GMR(GMRAFILE,DA(1),GMRAND,DA,0))
IF $PIECE(^(0),U,2)=GMRAREC
DO ^DIK
SET GMRAFLG=1
+27 IF GMRAFLG
IF GMRAFILE'=120.85
DO EN1^GMRAPTB
+28 QUIT
ADREAC ; ADD ENTRY TO SIGNS/SYMPTOMS MULTIPLE
+1 SET GMRAZN=$PIECE(^GMR(GMRAFILE,GMRAIEN,GMRAND,0),U,3,4)
SET DA=$PIECE(GMRAZN,U)+1
FOR DA=DA:1
IF '$DATA(^GMR(GMRAFILE,GMRAIEN,GMRAND,DA,0))
QUIT
+2 SET ^GMR(GMRAFILE,GMRAIEN,GMRAND,DA,0)=X
+3 SET DA(1)=GMRAIEN
+4 SET DIK="^GMR("_GMRAFILE_",DA(1),"_GMRAND_","
DO IX1^DIK
SET $PIECE(^GMR(GMRAFILE,GMRAIEN,GMRAND,0),U,3,4)=DA_U_($PIECE(GMRAZN,U,2)+1)
+5 ;IHS/MSC/MGH Added source for reaction
+6 IF +X2
Begin DoDot:1
+7 SET DIE="^GMR(120.8,GMRAIEN,GMRAND,"
+8 SET DA(1)=GMRAIEN
SET DR="9999999.11///^S X=X2"
+9 DO ^DIE
+10 KILL DIE,DR
End DoDot:1
+11 QUIT
PAT ;This is to process entries in file 120.8 on the 10 mutli.
+1 SET GMRAPA=GMRAIEN
+2 ; Validate entry
NEW DFN
SET DFN=$PIECE($GET(^GMR(120.8,GMRAPA,0)),U)
IF 'DFN
WRITE !,"BAD DATA CONTACT IRM",$CHAR(7)
SET GMRAOUT=1
QUIT
+3 SET GMRAPA(0)=^GMR(120.8,GMRAPA,0)
+4 QUIT
ADR ;This is to load the data in 120.85 on the 2 Multi.
+1 SET GMRANDT=1
+2 SET GMRAPA1=GMRAIEN
+3 ; Validate entry
SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
IF GMRAPA1(0)=""
WRITE !,"BAD DATA CONTACT IRM",$CHAR(7)
SET GMRAOUT=1
QUIT
+4 ; Validate entry
SET GMRAPA=$PIECE(GMRAPA1(0),U,15)
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
IF GMRAPA=""
WRITE !,"BAD DATA CONTACT IRM",$CHAR(7)
SET GMRAOUT=1
QUIT
+5 QUIT
LOAD(GMRAIEN,GMRAFILE,GMRAND) ;
+1 ;Load existing entries in the given file
+2 ;INPUT:
+3 ; GMRAIEN IS THE IEN OF THE FILE THAT IS BEING EDITED
+4 ; GMRAFILE IS THE FILE NUMBER
+5 ; GMRAND IS THE NODE MULTI
+6 ;OUTPUT
+7 ;
+8 NEW X,Y,Z
+9 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(GMRAFILE,GMRAIEN,GMRAND,GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:1
+10 SET Y=$SELECT($DATA(^GMR(GMRAFILE,GMRAIEN,GMRAND,GMRAX,0)):^(0),1:"")
+11 SET X=$SELECT(+Y=GMRAOTH:$PIECE(Y,U,2),$DATA(^GMRD(120.83,+Y,0)):$PIECE(^GMRD(120.83,+Y,0),U),1:"")
+12 ;Patch 1003 IHS/MSC/MGH
+13 IF X'=""
IF Y'=""
Begin DoDot:2
+14 SET GMRARPR(X,+Y)=X_U_$PIECE(Y,U,3)_U_$PIECE(Y,U,4)
+15 SET Z=$SELECT($DATA(^GMR(GMRAFILE,GMRAIEN,GMRAND,GMRAX,9999999.11)):^(9999999.11),1:"")
+16 IF Z'=""
SET GMRARPR(X,+Y)=GMRARPR(X,+Y)_U_$PIECE(Z,U,1)
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT
EXIT ;KILL CLEAN
+1 QUIT
SOURCE() ;Get the source
+1 NEW DA,DIC,DR,Y
+2 SET DIC=90460.05
+3 SET DIC(0)="AEMQ"
+4 SET DIC("S")="I $P(^(0),U,2)=""S"""
+5 SET DIC("A")="Select source: "
+6 DO ^DIC
IF $DATA(DIRUT)
KILL DIRUT
QUIT -1
+7 QUIT Y
