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 Oct 16, 2024@17:39:42 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
