- GMRADSP0 ;HIRMFO/WAA - DISPLAY ALLERGY ;08/01/2013 09:58
- ;;4.0;Adverse Reaction Tracking;**46**;Mar 29, 1996;Build 62
- EN1(GMRAL) ; This routine will print all the reaction in the GMRAL array
- ; for the given DFN.
- ; Input variables:
- ; GMRAL = An array of all the patient allergies.
- ;
- K ^TMP($J,"GMRALST")
- N GMRATYPE,GMRALN,GMRANAME,GMRAPA
- I $D(XRTL) D T0^%ZOSV ; START RT
- S GMRAOUT=0,GMRAOSOF=1
- I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV ; STOP RT
- ;sort list builder subroutine
- ;This subroutine builds the a ^TMP array in the following format:
- ; ^TMP($J,"GMRALST",type,name,ien)=""
- I GMRAL S GMRAPA=0 F S GMRAPA=$O(GMRAL(GMRAPA)) Q:GMRAPA<1 D
- .S ^TMP($J,"GMRALST",$P(GMRAL(GMRAPA),U,7),$P(GMRAL(GMRAPA),U,2),GMRAPA)=""
- .Q
- ALLTYP ;Loop through the list created by the sort subroutine and print.
- D HEAD^GMRADSP8
- S GMRATYPE="" F S GMRATYPE=$O(^TMP($J,"GMRALST",GMRATYPE)) Q:GMRATYPE="" D Q:GMRAOUT
- .S GMRANAME="" F S GMRANAME=$O(^TMP($J,"GMRALST",GMRATYPE,GMRANAME)) Q:GMRANAME="" D Q:GMRAOUT
- .. S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRALST",GMRATYPE,GMRANAME,GMRAPA)) Q:GMRAPA<1 D Q:GMRAOUT
- ...N GMALN
- ...D DISBLD^GMRADSP1(GMRAPA,.GMALN)
- ...D DISPLAY^GMRADSP8(.GMALN) Q:GMRAOUT
- ...Q
- ..Q
- .Q
- S:GMRAOUT GMRAOUT=2-GMRAOUT
- Q
- EXIT ;Exit
- K ^TMP($J,"GMRALST")
- S:GMRAOUT GMRAOUT=2-GMRAOUT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADSP0 1356 printed Jan 18, 2025@02:40:05 Page 2
- GMRADSP0 ;HIRMFO/WAA - DISPLAY ALLERGY ;08/01/2013 09:58
- +1 ;;4.0;Adverse Reaction Tracking;**46**;Mar 29, 1996;Build 62
- EN1(GMRAL) ; This routine will print all the reaction in the GMRAL array
- +1 ; for the given DFN.
- +2 ; Input variables:
- +3 ; GMRAL = An array of all the patient allergies.
- +4 ;
- +5 KILL ^TMP($JOB,"GMRALST")
- +6 NEW GMRATYPE,GMRALN,GMRANAME,GMRAPA
- +7 ; START RT
- IF $DATA(XRTL)
- DO T0^%ZOSV
- +8 SET GMRAOUT=0
- SET GMRAOSOF=1
- +9 ; STOP RT
- IF $DATA(XRT0)
- SET XRTN=$TEXT(+0)
- DO T1^%ZOSV
- +10 ;sort list builder subroutine
- +11 ;This subroutine builds the a ^TMP array in the following format:
- +12 ; ^TMP($J,"GMRALST",type,name,ien)=""
- +13 IF GMRAL
- SET GMRAPA=0
- FOR
- SET GMRAPA=$ORDER(GMRAL(GMRAPA))
- if GMRAPA<1
- QUIT
- Begin DoDot:1
- +14 SET ^TMP($JOB,"GMRALST",$PIECE(GMRAL(GMRAPA),U,7),$PIECE(GMRAL(GMRAPA),U,2),GMRAPA)=""
- +15 QUIT
- End DoDot:1
- ALLTYP ;Loop through the list created by the sort subroutine and print.
- +1 DO HEAD^GMRADSP8
- +2 SET GMRATYPE=""
- FOR
- SET GMRATYPE=$ORDER(^TMP($JOB,"GMRALST",GMRATYPE))
- if GMRATYPE=""
- QUIT
- Begin DoDot:1
- +3 SET GMRANAME=""
- FOR
- SET GMRANAME=$ORDER(^TMP($JOB,"GMRALST",GMRATYPE,GMRANAME))
- if GMRANAME=""
- QUIT
- Begin DoDot:2
- +4 SET GMRAPA=0
- FOR
- SET GMRAPA=$ORDER(^TMP($JOB,"GMRALST",GMRATYPE,GMRANAME,GMRAPA))
- if GMRAPA<1
- QUIT
- Begin DoDot:3
- +5 NEW GMALN
- +6 DO DISBLD^GMRADSP1(GMRAPA,.GMALN)
- +7 DO DISPLAY^GMRADSP8(.GMALN)
- if GMRAOUT
- QUIT
- +8 QUIT
- End DoDot:3
- if GMRAOUT
- QUIT
- +9 QUIT
- End DoDot:2
- if GMRAOUT
- QUIT
- +10 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +11 if GMRAOUT
- SET GMRAOUT=2-GMRAOUT
- +12 QUIT
- EXIT ;Exit
- +1 KILL ^TMP($JOB,"GMRALST")
- +2 if GMRAOUT
- SET GMRAOUT=2-GMRAOUT
- +3 QUIT