GMTSALGB ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002
;;2.7;Health Summary;**28,49**;Oct 20, 1995
;
; External References
; DBIA 10096 ^%ZOSF("TEST"
; DBIA 10099 EN1^GMRADPT
;
ALLRG ; Allergies
N I,Z,X,SEQ,GMTSA,ALLRG K GMTSA S (SEQ,ALLRG)=0 S X="GMRADPT" X ^%ZOSF("TEST")
I $T D Q:$D(GMTSQIT)
. D GETALLRG I ALLRG D
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?3,"Allergy/Reaction: " D ALLRGP
Q
ALLRGP ; Allergy Print
D CKP^GMTSUP Q:$D(GMTSQIT) W ?21 S X=0
F I=0:0 S I=$O(GMTSA(I)) Q:I="" D Q:$D(GMTSQIT)
. S X=X+1 W:X>1 ", " W:(77)'>($X+$L(GMTSA(I))) !
. D CKP^GMTSUP Q:$D(GMTSQIT) W GMTSA(I)
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
GETALLRG ; Get Allergies
N GMI,GMJ,GMRAL D EN1^GMRADPT I GMRAL="" S ALLRG=0 Q
I GMRAL="0" S ALLRG=1,GMTSA(1)="No Known Allergies" Q
S ALLRG=1,GMI=0 F S GMI=$O(GMRAL(GMI)) Q:GMI'>0 D
. S GMTSA(GMI)=$P(GMRAL(GMI),U,2)
. S GMJ=0 F S GMJ=$O(GMTSA(GMJ)) Q:GMJ'>0 I GMI'=GMJ,(GMTSA(GMI)=$G(GMTSA(GMJ))) K GMTSA(GMI) Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSALGB 1063 printed Dec 13, 2024@01:57:05 Page 2
GMTSALGB ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002
+1 ;;2.7;Health Summary;**28,49**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10096 ^%ZOSF("TEST"
+5 ; DBIA 10099 EN1^GMRADPT
+6 ;
ALLRG ; Allergies
+1 NEW I,Z,X,SEQ,GMTSA,ALLRG
KILL GMTSA
SET (SEQ,ALLRG)=0
SET X="GMRADPT"
XECUTE ^%ZOSF("TEST")
+2 IF $TEST
Begin DoDot:1
+3 DO GETALLRG
IF ALLRG
Begin DoDot:2
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?3,"Allergy/Reaction: "
DO ALLRGP
End DoDot:2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+5 QUIT
ALLRGP ; Allergy Print
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21
SET X=0
+2 FOR I=0:0
SET I=$ORDER(GMTSA(I))
if I=""
QUIT
Begin DoDot:1
+3 SET X=X+1
if X>1
WRITE ", "
if (77)'>($X+$LENGTH(GMTSA(I)))
WRITE !
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE GMTSA(I)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+5 if $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !
QUIT
GETALLRG ; Get Allergies
+1 NEW GMI,GMJ,GMRAL
DO EN1^GMRADPT
IF GMRAL=""
SET ALLRG=0
QUIT
+2 IF GMRAL="0"
SET ALLRG=1
SET GMTSA(1)="No Known Allergies"
QUIT
+3 SET ALLRG=1
SET GMI=0
FOR
SET GMI=$ORDER(GMRAL(GMI))
if GMI'>0
QUIT
Begin DoDot:1
+4 SET GMTSA(GMI)=$PIECE(GMRAL(GMI),U,2)
+5 SET GMJ=0
FOR
SET GMJ=$ORDER(GMTSA(GMJ))
if GMJ'>0
QUIT
IF GMI'=GMJ
IF (GMTSA(GMI)=$GET(GMTSA(GMJ)))
KILL GMTSA(GMI)
QUIT
End DoDot:1
+6 QUIT
