- 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