GMTSALGB.m

GMTSALGB ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ;08-Mar-2011 08:39;DU

 ;;2.7;Health Summary;**28,49,1004**;Oct 20, 1995;Build 9

 ;

 ; 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,GMTAL,CHK,GMRAUNDT,GMRAL

 D UNASS^GMTSALG(DFN)

 I GMRAUNDT'="" D CKP^GMTSUP Q:$D(GMTSQIT)  W:$L($G(GMRAUNDT)) !,?1,"Unassessable at this time: ",GMRAUNDT,!

 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

GMTSALGB  ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ;08-Mar-2011 08:39;DU

 +1       ;;2.7;Health Summary;**28,49,1004**;Oct 20, 1995;Build 9

 +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,GMTAL,CHK,GMRAUNDT,GMRAL

 +2        DO UNASS^GMTSALG(DFN)

 +3        IF GMRAUNDT'=""

               DO CKP^GMTSUP

               IF $DATA(GMTSQIT)

                   QUIT 

               IF $LENGTH($GET(GMRAUNDT))

                   WRITE !,?1,"Unassessable at this time: ",GMRAUNDT,!

 +4        DO EN1^GMRADPT

           IF GMRAL=""

               SET ALLRG=0

               QUIT 

 +5        IF GMRAL="0"

               SET ALLRG=1

               SET GMTSA(1)="No Known Allergies"

               QUIT 

 +6        SET ALLRG=1

           SET GMI=0

           FOR 

               SET GMI=$ORDER(GMRAL(GMI))

               IF GMI'>0

                   QUIT 

               Begin DoDot:1

 +7                SET GMTSA(GMI)=$PIECE(GMRAL(GMI),U,2)

 +8                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

 +9        QUIT