BHSHS2.m

BHSHS2 ;IHS/CIA/MGH - Health Summary Driver for ashtma, dental, RCIS and behavioral health ;17-Mar-2006 10:36;MGH

 ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006

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

 ;This is the driving routine for VA health summaries to be made from

 ;the asthma registry, dental, behavioral health, and referred care

 ;Redone for conversion to VA health summary

 ;Taken from APCHS9

 ; IHS/TUCSON/LAB - PART 9 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;02

 ;;2.0;IHS RPMS/PCC Health Summary;**3,8,10**;JUN 24, 1997

 ;

AST ;EP - called from component

 ;*************** ASTHMA REGISRY **********************

 NEW X,S,BHSPAT

 S BHSPAT=DFN

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

 ;asthma dx ever or asthma on pl or ast

 NEW D,P,A

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

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

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

 Q

AST1 ;

 ;Routine that will find and display the ashtma registry data

 D REG^BHSASM

 Q

DENTAL ;EP -called from component

 ; ********** DENTAL SERVICES * 9002001 **********

 NEW X,BHSPAT,ADEPAT

 S (BHSPAT,ADEPAT)=DFN

 S X="ADERVW" X ^%ZOSF("TEST") I $T G START^BHSDEN ; <SETUP>

 Q:'$D(^ADESVC(BHSPAT))

 D CKP^GMTSUP Q:$D(GMTSQIT)

 ; <DISPLAY>

 W "<DENTAL SERVICES DISPLAY ROUTINE MISSING!>",!

 ; <CLEANUP>

DENTALX K X

 Q

 ;

 ;

MHSS ;EP ********* MENTAL HEALTH/SOCIAL SERVICES * 9002011

 NEW X,BHSPAT

 S BHSPAT=DFN

 I +$D(^XUSEC("AMHZHS",DUZ)) D

 .S X="AMHHS" X ^%ZOSF("TEST") I $T G MH^BHSBH ; <SETUP>

 Q:'$D(^AMHREC("AC",BHSPAT))

 D CKP^GMTSUP Q:$D(GMTSQIT)

 ; <DISPLAY>

 W "<MH/SS DISPLAY ROUTINE MISSING!>",!

 ; <CLEANUP>

MHSSX ;MHSS EXIT

 K X

 Q

CHR ;EP ********* CHR COMPONENT * 90002

 NEW X,BHSPAT

 S BHSPAT=DFN

 S X="BCHDHS" X ^%ZOSF("TEST") I $T G CHR^BHSBCH ; <SETUP>

 Q:'$D(^BCHR("AC",BHSPAT))

 D CKP^GMTSUP Q:$D(GMTSQIT)

 ; <DISPLAY>

 W "<CHR DISPLAY ROUTINE MISSING!>",!

 ; <CLEANUP>

CHRX ;CHR EXIT

 K X

 Q

MCIS ; *********** MANAGED CARE MIS * 90001

 NEW X,BHSPAT

 S BHSPAT=DFN

 S X="BMCHS"

 X ^%ZOSF("TEST") I $T G HS^BHSRCIS ; write mcis summary

 G:'$D(^BMCREF("D",BHSPAT)) MCISX ; exit if no referrals for patient

 D CKP^GMTSUP Q:$D(GMTSQIT)

 W "<MCIS DISPLAY ROUTINE MISSING!>",!

MCISX ;MCIS EXIT

 Q

BHSHS2    ;IHS/CIA/MGH - Health Summary Driver for ashtma, dental, RCIS and behavioral health ;17-Mar-2006 10:36;MGH

 +1       ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006

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

 +3       ;This is the driving routine for VA health summaries to be made from

 +4       ;the asthma registry, dental, behavioral health, and referred care

 +5       ;Redone for conversion to VA health summary

 +6       ;Taken from APCHS9

 +7       ; IHS/TUCSON/LAB - PART 9 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;02

 +8       ;;2.0;IHS RPMS/PCC Health Summary;**3,8,10**;JUN 24, 1997

 +9       ;

AST       ;EP - called from component

 +1       ;*************** ASTHMA REGISRY **********************

 +2        NEW X,S,BHSPAT

 +3        SET BHSPAT=DFN

 +4        SET X="BATSUM"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               QUIT 

 +5       ;asthma dx ever or asthma on pl or ast

 +6        NEW D,P,A

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

           IF A

               GOTO AST1

 +8        SET A=$$PLAST^BATU(BHSPAT)

           IF A]""

               GOTO AST1

 +9        SET A=$$DXAST^BATU(BHSPAT)

           IF A

               GOTO AST1

 +10       QUIT 

AST1      ;

 +1       ;Routine that will find and display the ashtma registry data

 +2        DO REG^BHSASM

 +3        QUIT 

DENTAL    ;EP -called from component

 +1       ; ********** DENTAL SERVICES * 9002001 **********

 +2        NEW X,BHSPAT,ADEPAT

 +3        SET (BHSPAT,ADEPAT)=DFN

 +4       ; <SETUP>

           SET X="ADERVW"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               GOTO START^BHSDEN

 +5        IF '$DATA(^ADESVC(BHSPAT))

               QUIT 

 +6        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT 

 +7       ; <DISPLAY>

 +8        WRITE "<DENTAL SERVICES DISPLAY ROUTINE MISSING!>",!

 +9       ; <CLEANUP>

DENTALX    KILL X

 +1        QUIT 

 +2       ;

 +3       ;

MHSS      ;EP ********* MENTAL HEALTH/SOCIAL SERVICES * 9002011

 +1        NEW X,BHSPAT

 +2        SET BHSPAT=DFN

 +3        IF +$DATA(^XUSEC("AMHZHS",DUZ))

               Begin DoDot:1

 +4       ; <SETUP>

                   SET X="AMHHS"

                   XECUTE ^%ZOSF("TEST")

                   IF $TEST

                       GOTO MH^BHSBH

               End DoDot:1

 +5        IF '$DATA(^AMHREC("AC",BHSPAT))

               QUIT 

 +6        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT 

 +7       ; <DISPLAY>

 +8        WRITE "<MH/SS DISPLAY ROUTINE MISSING!>",!

 +9       ; <CLEANUP>

MHSSX     ;MHSS EXIT

 +1        KILL X

 +2        QUIT 

CHR       ;EP ********* CHR COMPONENT * 90002

 +1        NEW X,BHSPAT

 +2        SET BHSPAT=DFN

 +3       ; <SETUP>

           SET X="BCHDHS"

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               GOTO CHR^BHSBCH

 +4        IF '$DATA(^BCHR("AC",BHSPAT))

               QUIT 

 +5        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT 

 +6       ; <DISPLAY>

 +7        WRITE "<CHR DISPLAY ROUTINE MISSING!>",!

 +8       ; <CLEANUP>

CHRX      ;CHR EXIT

 +1        KILL X

 +2        QUIT 

MCIS      ; *********** MANAGED CARE MIS * 90001

 +1        NEW X,BHSPAT

 +2        SET BHSPAT=DFN

 +3        SET X="BMCHS"

 +4       ; write mcis summary

           XECUTE ^%ZOSF("TEST")

           IF $TEST

               GOTO HS^BHSRCIS

 +5       ; exit if no referrals for patient

           IF '$DATA(^BMCREF("D",BHSPAT))

               GOTO MCISX

 +6        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT 

 +7        WRITE "<MCIS DISPLAY ROUTINE MISSING!>",!

MCISX     ;MCIS EXIT

 +1        QUIT