- GMRAOR1 ; HIRMFO/RM,WAA - OERR UTILITIES ;May 11, 2021@12:07:22
- ;;4.0;Adverse Reaction Tracking;**21,41,46,63**;Mar 29, 1996;Build 34
- EN1(DFN,ARRAY) ;RETURN CONDENSED LIST OF PATIENT REACTIONS
- ;CONTROLLED BY CONTROLLED SUBSCRIPTION INTEGRATION AGREEMENT #2421
- ;PARAMETERS: DFN => INTERNAL ENTRY NUMBER (IEN) OF THE PATIENT
- ; IN THE PATIENT FILE (#2).
- ; ARRAY => NAME OF THE ARRAY IN WHICH TO RETURN THE
- ; REACTIONS. IF NOTHING IS PASSED IN, DATA
- ; IS RETURNED IN THE GMRARXN ARRAY.
- ; GMRA => REACTION SEARCH CRITERIA; REFER TO ^GMRADPT
- ; FOR DETAILS
- ; GMRAIDT => WHEN SET, WILL RETURN THE DATE ENTERED FOR
- ; THE SIGN/SYMPTOM IN THE SECOND SEMI-COLON
- ; PIECE
- Q:+$G(DFN)'>0
- S ARRAY=$G(ARRAY,"GMRARXN")
- Q:ARRAY="GMRAL"
- N GMRAL
- K @ARRAY
- D EN2^GMRADPT
- I GMRAL D
- .N GMRAIEN,GMRASS
- .S GMRAIEN="" F S GMRAIEN=$O(GMRAL(GMRAIEN)) Q:GMRAIEN="" D
- ..N GMRAGMR,GMRAIDX,GMRASEV
- ..S @ARRAY=1+$G(@ARRAY)
- ..I $P(GMRAL(GMRAIEN),U,7)["D" D
- ...S GMRAGMR=$$EXTERNAL^DILFD(120.8,1,,$P(GMRAL(GMRAIEN),U,9))
- ...I $P(GMRAL(GMRAIEN),U,2)'=GMRAGMR,($P(GMRAL(GMRAIEN),U,9)'["50.605") S @ARRAY@(@ARRAY)=GMRAGMR_" ["_$P(GMRAL(GMRAIEN),U,2)_"]"
- ..I $P(GMRAL(GMRAIEN),U,7)'["D"!('$D(@ARRAY@(@ARRAY))) D
- ...S @ARRAY@(@ARRAY)=$P(GMRAL(GMRAIEN),U,2)
- ..I $P($P(GMRAL(GMRAIEN),U,10),";",2)="o" D
- ...S GMRAIDX=0 F S GMRAIDX=$O(GMRAL(GMRAIEN,"O",GMRAIDX)) Q:'+GMRAIDX D
- ....I $P($P(GMRAL(GMRAIEN,"O",GMRAIDX),U),";",2)>$G(GMRASEV) S GMRASEV=$P($P(GMRAL(GMRAIEN,"O",GMRAIDX),U),";",2)
- ...I $G(GMRASEV)>0 S GMRASEV=$$EXTERNAL^DILFD(120.85,14.5,,GMRASEV)
- ..I $P($P(GMRAL(GMRAIEN),U,10),";",2)="h" D
- ...S GMRASEV=$P($P(GMRAL(GMRAIEN,"H"),U),";")
- ..S @ARRAY@(@ARRAY)=@ARRAY@(@ARRAY)_U_$G(GMRASEV)_U_GMRAIEN
- ..S GMRASS=0 F S GMRASS=$O(GMRAL(GMRAIEN,"S",GMRASS)) Q:GMRASS<1 D
- ...S @ARRAY@(@ARRAY,"S",GMRASS)=$P($P(GMRAL(GMRAIEN,"S",GMRASS),U),";")_$S($G(GMRAIDT):";"_$P($P(GMRAL(GMRAIEN,"S",GMRASS),U,2),";",2),1:"")
- S @ARRAY=GMRAL
- Q
- ;*BD
- 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
- ;*ED
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAOR1 2482 printed Feb 18, 2025@23:06:01 Page 2
- GMRAOR1 ; HIRMFO/RM,WAA - OERR UTILITIES ;May 11, 2021@12:07:22
- +1 ;;4.0;Adverse Reaction Tracking;**21,41,46,63**;Mar 29, 1996;Build 34
- EN1(DFN,ARRAY) ;RETURN CONDENSED LIST OF PATIENT REACTIONS
- +1 ;CONTROLLED BY CONTROLLED SUBSCRIPTION INTEGRATION AGREEMENT #2421
- +2 ;PARAMETERS: DFN => INTERNAL ENTRY NUMBER (IEN) OF THE PATIENT
- +3 ; IN THE PATIENT FILE (#2).
- +4 ; ARRAY => NAME OF THE ARRAY IN WHICH TO RETURN THE
- +5 ; REACTIONS. IF NOTHING IS PASSED IN, DATA
- +6 ; IS RETURNED IN THE GMRARXN ARRAY.
- +7 ; GMRA => REACTION SEARCH CRITERIA; REFER TO ^GMRADPT
- +8 ; FOR DETAILS
- +9 ; GMRAIDT => WHEN SET, WILL RETURN THE DATE ENTERED FOR
- +10 ; THE SIGN/SYMPTOM IN THE SECOND SEMI-COLON
- +11 ; PIECE
- +12 if +$GET(DFN)'>0
- QUIT
- +13 SET ARRAY=$GET(ARRAY,"GMRARXN")
- +14 if ARRAY="GMRAL"
- QUIT
- +15 NEW GMRAL
- +16 KILL @ARRAY
- +17 DO EN2^GMRADPT
- +18 IF GMRAL
- Begin DoDot:1
- +19 NEW GMRAIEN,GMRASS
- +20 SET GMRAIEN=""
- FOR
- SET GMRAIEN=$ORDER(GMRAL(GMRAIEN))
- if GMRAIEN=""
- QUIT
- Begin DoDot:2
- +21 NEW GMRAGMR,GMRAIDX,GMRASEV
- +22 SET @ARRAY=1+$GET(@ARRAY)
- +23 IF $PIECE(GMRAL(GMRAIEN),U,7)["D"
- Begin DoDot:3
- +24 SET GMRAGMR=$$EXTERNAL^DILFD(120.8,1,,$PIECE(GMRAL(GMRAIEN),U,9))
- +25 IF $PIECE(GMRAL(GMRAIEN),U,2)'=GMRAGMR
- IF ($PIECE(GMRAL(GMRAIEN),U,9)'["50.605")
- SET @ARRAY@(@ARRAY)=GMRAGMR_" ["_$PIECE(GMRAL(GMRAIEN),U,2)_"]"
- End DoDot:3
- +26 IF $PIECE(GMRAL(GMRAIEN),U,7)'["D"!('$DATA(@ARRAY@(@ARRAY)))
- Begin DoDot:3
- +27 SET @ARRAY@(@ARRAY)=$PIECE(GMRAL(GMRAIEN),U,2)
- End DoDot:3
- +28 IF $PIECE($PIECE(GMRAL(GMRAIEN),U,10),";",2)="o"
- Begin DoDot:3
- +29 SET GMRAIDX=0
- FOR
- SET GMRAIDX=$ORDER(GMRAL(GMRAIEN,"O",GMRAIDX))
- if '+GMRAIDX
- QUIT
- Begin DoDot:4
- +30 IF $PIECE($PIECE(GMRAL(GMRAIEN,"O",GMRAIDX),U),";",2)>$GET(GMRASEV)
- SET GMRASEV=$PIECE($PIECE(GMRAL(GMRAIEN,"O",GMRAIDX),U),";",2)
- End DoDot:4
- +31 IF $GET(GMRASEV)>0
- SET GMRASEV=$$EXTERNAL^DILFD(120.85,14.5,,GMRASEV)
- End DoDot:3
- +32 IF $PIECE($PIECE(GMRAL(GMRAIEN),U,10),";",2)="h"
- Begin DoDot:3
- +33 SET GMRASEV=$PIECE($PIECE(GMRAL(GMRAIEN,"H"),U),";")
- End DoDot:3
- +34 SET @ARRAY@(@ARRAY)=@ARRAY@(@ARRAY)_U_$GET(GMRASEV)_U_GMRAIEN
- +35 SET GMRASS=0
- FOR
- SET GMRASS=$ORDER(GMRAL(GMRAIEN,"S",GMRASS))
- if GMRASS<1
- QUIT
- Begin DoDot:3
- +36 SET @ARRAY@(@ARRAY,"S",GMRASS)=$PIECE($PIECE(GMRAL(GMRAIEN,"S",GMRASS),U),";")_$SELECT($GET(GMRAIDT):";"_$PIECE($PIECE(GMRAL(GMRAIEN,"S",GMRASS),U,2),";",2),1:"")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +37 SET @ARRAY=GMRAL
- +38 QUIT
- +39 ;*BD
- 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 ;*ED