source: qrda/C0Q/trunk/p/C0QGMTSA.m@ 1751

Last change on this file since 1751 was 1501, checked in by Sam Habiel, 12 years ago

Latest routines; T11 copy

File size: 1.0 KB
RevLine 
[1223]1C0QGMTSA ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002
[1501]2 ;;1.0;C0Q;;May 21, 2012;Build 63
[1223]3 ;
4 ; External References
5 ; DBIA 10096 ^%ZOSF("TEST"
6 ; DBIA 10099 EN1^GMRADPT **LOCAL NOW EN1^C0QGMRAD
7 ;
8ALLRG ; 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
14ALLRGP ; 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
20GETALLRG ; 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.