- GMRAOR1 ;HIRMFO/RM,WAA-OERR UTILITIES ;01-May-2012 14:20;DU
- ;;4.0;Adverse Reaction Tracking;**21,41,1002,1006**;Mar 29, 1996;Build 29
- ;IHS/MSC/MGH added call to rerurn unaccessible Patches 1002,1006
- EN1(DFN,ARRAY) ; This entry returns a list of patient allergies/adverse
- ; reactions.
- ; Input variables:
- ; DFN = IEN of patient in Patient (2) file
- ; ARRAY = Return array for Patient reactions.
- ; If ARRAY="" or undefined default will be GMRARXN.
- Q:$G(DFN)'>0
- S ARRAY=$S($G(ARRAY)'="":ARRAY,1:ARRAY="GMRARXN") Q:ARRAY="GMRAL"
- K GMRARXN,GMRAL,@ARRAY
- D EN1^GMRADPT ; Get Patient Allergies
- I GMRAL D ; If the patient has reaction then reprocess to OERR Fmt
- .N GMRAIEN,GMRADFN,%,GMRASVR
- .S GMRARXN=1,GMRAIEN=0
- .F S GMRAIEN=$O(GMRAL(GMRAIEN)) Q:GMRAIEN<1 D
- ..S GMRARXN(GMRARXN)=$P(GMRAL(GMRAIEN),U,2)_U ; Get freetext of agent.
- ..; Loop through 120.85 file to find all observed reacting reports for
- ..; this reaction. Grab severity and store only the highest value.
- ..S GMRADFN=0,%="",GMRASVR="" F S GMRADFN=$O(^GMR(120.85,"C",GMRAIEN,GMRADFN)) Q:GMRADFN<1 S %=$P($G(^GMR(120.85,GMRADFN,0)),U,14) S:%>+GMRASVR GMRASVR=%
- ..S GMRARXN(GMRARXN)=GMRARXN(GMRARXN)_$S(GMRASVR=1:"MILD",GMRASVR=2:"MODERATE",GMRASVR=3:"SEVERE",1:"")_U_GMRAIEN
- ..;Loop through the S/S multiple and get the external format and possibly the date/time.
- ..S %=0 F S %=$O(GMRAL(GMRAIEN,"S",%)) Q:%<1 S GMRARXN(GMRARXN,"S",%)=$P(GMRAL(GMRAIEN,"S",%),";")_$S($G(GMRAIDT):";"_$P(^GMR(120.8,GMRAIEN,10,$O(^GMR(120.8,GMRAIEN,10,"B",$P($P(GMRAL(GMRAIEN,"S",%),";",2),"^",1),0)),0),U,4),1:"") ;21
- ..S GMRARXN=GMRARXN+1
- ..Q
- .S GMRARXN=1
- .Q
- E S GMRARXN=GMRAL
- I ARRAY'="GMRARXN" M @ARRAY=GMRARXN K GMRARXN
- K GMRAL
- Q
- SETNODE(ITEM,DATA) ;
- N VALUE
- S VALUE=""
- I ITEM[DATA S VALUE=ITEM Q VALUE
- I DATA="LOCAL" D Q VALUE
- .I ITEM="" S VALUE="LOCAL" Q
- .I ITEM["REMOTE SITE(S)" S VALUE="LOCAL AND REMOTE SITE(S)"
- I DATA="REMOTE SITE(S)" D Q VALUE
- .I ITEM="" S VALUE="REMOTE SITE(S)" Q
- .I ITEM["LOCAL" S VALUE="LOCAL AND REMOTE SITE(S)"
- Q VALUE
- ;
- UNASS(ORPT) ;
- ;IHS/MSC/MGH added call to rerurn unaccessible Patch 1006
- N Y,RESULT
- S RESULT=1
- S Y=$O(^GMR(120.86,ORPT,9999999.11,$C(0)),-1) I +Y D
- .I $P($G(^GMR(120.86,ORPT,9999999.11,Y,0)),U,4)="" D
- ..S RESULT=0
- Q RESULT
- GMRAOR1 ;HIRMFO/RM,WAA-OERR UTILITIES ;01-May-2012 14:20;DU
- +1 ;;4.0;Adverse Reaction Tracking;**21,41,1002,1006**;Mar 29, 1996;Build 29
- +2 ;IHS/MSC/MGH added call to rerurn unaccessible Patches 1002,1006
- EN1(DFN,ARRAY) ; This entry returns a list of patient allergies/adverse
- +1 ; reactions.
- +2 ; Input variables:
- +3 ; DFN = IEN of patient in Patient (2) file
- +4 ; ARRAY = Return array for Patient reactions.
- +5 ; If ARRAY="" or undefined default will be GMRARXN.
- +6 IF $GET(DFN)'>0
- QUIT
- +7 SET ARRAY=$SELECT($GET(ARRAY)'="":ARRAY,1:ARRAY="GMRARXN")
- IF ARRAY="GMRAL"
- QUIT
- +8 KILL GMRARXN,GMRAL,@ARRAY
- +9 ; Get Patient Allergies
- DO EN1^GMRADPT
- +10 ; If the patient has reaction then reprocess to OERR Fmt
- IF GMRAL
- Begin DoDot:1
- +11 NEW GMRAIEN,GMRADFN,%,GMRASVR
- +12 SET GMRARXN=1
- SET GMRAIEN=0
- +13 FOR
- SET GMRAIEN=$ORDER(GMRAL(GMRAIEN))
- IF GMRAIEN<1
- QUIT
- Begin DoDot:2
- +14 ; Get freetext of agent.
- SET GMRARXN(GMRARXN)=$PIECE(GMRAL(GMRAIEN),U,2)_U
- +15 ; Loop through 120.85 file to find all observed reacting reports for
- +16 ; this reaction. Grab severity and store only the highest value.
- +17 SET GMRADFN=0
- SET %=""
- SET GMRASVR=""
- FOR
- SET GMRADFN=$ORDER(^GMR(120.85,"C",GMRAIEN,GMRADFN))
- IF GMRADFN<1
- QUIT
- SET %=$PIECE($GET(^GMR(120.85,GMRADFN,0)),U,14)
- IF %>+GMRASVR
- SET GMRASVR=%
- +18 SET GMRARXN(GMRARXN)=GMRARXN(GMRARXN)_$SELECT(GMRASVR=1:"MILD",GMRASVR=2:"MODERATE",GMRASVR=3:"SEVERE",1:"")_U_GMRAIEN
- +19 ;Loop through the S/S multiple and get the external format and possibly the date/time.
- +20 ;21
- SET %=0
- FOR
- SET %=$ORDER(GMRAL(GMRAIEN,"S",%))
- IF %<1
- QUIT
- SET GMRARXN(GMRARXN,"S",%)=$PIECE(GMRAL(GMRAIEN,"S",%),";")_$SELECT($GET(GMRAIDT):";"_$PIECE(^GMR(120.8,GMRAIEN,10,$ORDER(^GMR(120.8,GMRAIEN,10,"B",$PIECE($PIECE(GMRAL(GMRAIEN,"S",%),";",2),"^",1),0)),0),U,4),1:"")
- +21 SET GMRARXN=GMRARXN+1
- +22 QUIT
- End DoDot:2
- +23 SET GMRARXN=1
- +24 QUIT
- End DoDot:1
- +25 IF '$TEST
- SET GMRARXN=GMRAL
- +26 IF ARRAY'="GMRARXN"
- MERGE @ARRAY=GMRARXN
- KILL GMRARXN
- +27 KILL GMRAL
- +28 QUIT
- SETNODE(ITEM,DATA) ;
- +1 NEW VALUE
- +2 SET VALUE=""
- +3 IF ITEM[DATA
- SET VALUE=ITEM
- QUIT VALUE
- +4 IF DATA="LOCAL"
- Begin DoDot:1
- +5 IF ITEM=""
- SET VALUE="LOCAL"
- QUIT
- +6 IF ITEM["REMOTE SITE(S)"
- SET VALUE="LOCAL AND REMOTE SITE(S)"
- End DoDot:1
- QUIT VALUE
- +7 IF DATA="REMOTE SITE(S)"
- Begin DoDot:1
- +8 IF ITEM=""
- SET VALUE="REMOTE SITE(S)"
- QUIT
- +9 IF ITEM["LOCAL"
- SET VALUE="LOCAL AND REMOTE SITE(S)"
- End DoDot:1
- QUIT VALUE
- +10 QUIT VALUE
- +11 ;
- UNASS(ORPT) ;
- +1 ;IHS/MSC/MGH added call to rerurn unaccessible Patch 1006
- +2 NEW Y,RESULT
- +3 SET RESULT=1
- +4 SET Y=$ORDER(^GMR(120.86,ORPT,9999999.11,$CHAR(0)),-1)
- IF +Y
- Begin DoDot:1
- +5 IF $PIECE($GET(^GMR(120.86,ORPT,9999999.11,Y,0)),U,4)=""
- Begin DoDot:2
- +6 SET RESULT=0
- End DoDot:2
- End DoDot:1
- +7 QUIT RESULT
