|
Last change
on this file since 1743 was 1292, checked in by George Lilly, 13 years ago |
|
reorganizing the project for ohum contributions
|
|
File size:
1.0 KB
|
| Line | |
|---|
| 1 | C0QGMTSA ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**28,49**;Oct 20, 1995;Build 19
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10096 ^%ZOSF("TEST"
|
|---|
| 6 | ; DBIA 10099 EN1^GMRADPT **LOCAL NOW EN1^C0QGMRAD
|
|---|
| 7 | ;
|
|---|
| 8 | ALLRG ; Allergies
|
|---|
| 9 | N I,Z,X,SEQ,GMTSA,ALLRG K GMTSA S (SEQ,ALLRG)=0 S X="C0QGMRAD" X ^%ZOSF("TEST")
|
|---|
| 10 | I $T D Q:$D(GMTSQIT)
|
|---|
| 11 | . D GETALLRG I ALLRG D
|
|---|
| 12 | . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?3,"Allergy/Reaction: " D ALLRGP
|
|---|
| 13 | Q
|
|---|
| 14 | ALLRGP ; Allergy Print
|
|---|
| 15 | D CKP^GMTSUP Q:$D(GMTSQIT) W ?21 S X=0
|
|---|
| 16 | F I=0:0 S I=$O(GMTSA(I)) Q:I="" D Q:$D(GMTSQIT)
|
|---|
| 17 | . S X=X+1 W:X>1 ", " W:(77)'>($X+$L(GMTSA(I))) !
|
|---|
| 18 | . D CKP^GMTSUP Q:$D(GMTSQIT) W GMTSA(I)
|
|---|
| 19 | Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
|
|---|
| 20 | GETALLRG ; Get Allergies
|
|---|
| 21 | N GMI,GMJ,GMRAL D EN1^C0QGMRAD I GMRAL="" S ALLRG=0 Q
|
|---|
| 22 | I GMRAL="0" S ALLRG=1,GMTSA(1)="No Known Allergies" Q
|
|---|
| 23 | S ALLRG=1,GMI=0 F S GMI=$O(GMRAL(GMI)) Q:GMI'>0 D
|
|---|
| 24 | . S GMTSA(GMI)=$P(GMRAL(GMI),U,2)
|
|---|
| 25 | . S GMJ=0 F S GMJ=$O(GMTSA(GMJ)) Q:GMJ'>0 I GMI'=GMJ,(GMTSA(GMI)=$G(GMTSA(GMJ))) K GMTSA(GMI) Q
|
|---|
| 26 | Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
