- 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
