BHSASM.m

BHSASM ;IHS/CIA/MGH - Health Summary for Asthma Registry ;06-May-2010 10:25;MGH

 ;;1.0;HEALTH SUMMARY COMPONENTS;**3,4**;March 17, 2006;Build 13

 ;===================================================================

 ;Taken from APCHS9

 ;Health summary for asthma registry

 ;

REG ;asthma dx even or asthma on pl or ast

 NEW D,P,A,BHSPAT

 S BHSPAT=DFN

 S A=$O(^AUPNVAST("AA",BHSPAT,0)) I A G AST1

 S A=$$PLAST^BHSAST(BHSPAT) I A]"" G AST1

 S A=$$DXAST^BHSAST(BHSPAT) I A G AST1

 Q

AST1 ;

 D EP^BHSAST(BHSPAT)

 Q

CP ;EP

 NEW X S X="BCPSHSS" X ^%ZOSF("TEST") I '$T Q

 Q:'$D(^BCPP(DFN,0))  ;patient not in chronic patient file

 Q:'$D(^BCPA("AC",DFN))  ;no agreements

 D EP^BCPSHSS(DFN)

 Q

ANTICOAG ;EP - called from supplement

 ;has a diagnosis and a prescription for warfarin

 NEW D,P,A,B,BHSPAT

 S BHSPAT=DFN

 S B=$$ACTWARF^APCHSTP1(BHSPAT,$$FMADD^XLFDT(DT,-45),DT)

 I B G ANTICO1

 Q

ANTICO1 ;

 D EP^BHSACG(BHSPAT)

 Q

BHSASM    ;IHS/CIA/MGH - Health Summary for Asthma Registry ;06-May-2010 10:25;MGH

 +1       ;;1.0;HEALTH SUMMARY COMPONENTS;**3,4**;March 17, 2006;Build 13

 +2       ;===================================================================

 +3       ;Taken from APCHS9

 +4       ;Health summary for asthma registry

 +5       ;

REG       ;asthma dx even or asthma on pl or ast

 +1        NEW D,P,A,BHSPAT

 +2        SET BHSPAT=DFN

 +3        SET A=$ORDER(^AUPNVAST("AA",BHSPAT,0))

           IF A

               GOTO AST1

 +4        SET A=$$PLAST^BHSAST(BHSPAT)

           IF A]""

               GOTO AST1

 +5        SET A=$$DXAST^BHSAST(BHSPAT)

           IF A

               GOTO AST1

 +6        QUIT 

AST1      ;

 +1        DO EP^BHSAST(BHSPAT)

 +2        QUIT 

CP        ;EP

 +1        NEW X

           SET X="BCPSHSS"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +2       ;patient not in chronic patient file

           IF '$DATA(^BCPP(DFN,0))

               QUIT 

 +3       ;no agreements

           IF '$DATA(^BCPA("AC",DFN))

               QUIT 

 +4        DO EP^BCPSHSS(DFN)

 +5        QUIT 

ANTICOAG  ;EP - called from supplement

 +1       ;has a diagnosis and a prescription for warfarin

 +2        NEW D,P,A,B,BHSPAT

 +3        SET BHSPAT=DFN

 +4        SET B=$$ACTWARF^APCHSTP1(BHSPAT,$$FMADD^XLFDT(DT,-45),DT)

 +5        IF B

               GOTO ANTICO1

 +6        QUIT 

ANTICO1   ;

 +1        DO EP^BHSACG(BHSPAT)

 +2        QUIT