- BHSHOS ;IHS/CIA/MGH - Health Summary for hospitalization encounters ;17-Mar-2006 10:36;MGH
- ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006
- ;===================================================================
- ;Taken from APCHS2C
- ; IHS/TUCSON/LAB - PART 2C OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- ;;2.0;IHS RPMS/PCC Health Summary;;JUN 24, 1997
- ;VA verision of IHS health summary component for hospitalization encounters
- INPT ; ********** HOSPITALIZATION ENCOUNTERS * 9000010/900010.07 **********
- ; <SETUP>
- N BHSPAT,BHSQ,BHSNTE
- S BHSPAT=DFN
- Q:'$D(^AUPNVSIT("AAH",BHSPAT))
- D CKP^GMTSUP Q:$D(GMTSQIT)
- ; <DISPLAY>
- S BHSPVD=0
- S BHSIVD="" F BHSQ=0:0 S BHSIVD=$O(^AUPNVSIT("AAH",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM) D
- .D ONEDATE Q:$D(GMTSQIT) S:BHSDAT'=BHSPVD GMTSNDM=GMTSNDM-1,BHSPVD=BHSDAT Q:GMTSNDM=0
- ; <CLEANUP>
- INPTX K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSFO,BHSMTX,BHSMOD,BHSPVD,BHSHDN,BHSDDC,BHSCDN,BHSICD,BHSICL,BHSN,BHSNRQ,BHSPDN,BHSVTP
- K BHSNFL,BHSNSH,BHSNAB,BHSVSC,BHSITE,Y,X
- Q
- ONEDATE S X=-BHSIVD\1+9999999 D REGDT4^GMTSU S BHSDAT=X S BHSDTU=(BHSDAT=BHSPVD)
- S BHSVDF="" F BHSQ=0:0 S BHSVDF=$O(^AUPNVSIT("AAH",BHSPAT,BHSIVD,BHSVDF)) Q:BHSVDF="" S BHSN=^AUPNVSIT(BHSVDF,0) D GETSITEV^BHSUTL D:"H"[BHSVSC HOSP Q:$D(GMTSQIT)
- Q
- ;
- HOSP ;
- Q:$P(BHSN,U,9)=0!($P(BHSN,U,11)=1)
- S BHSVTP=$P(BHSN,U,3)
- S BHSDTU=1
- S BHSFAC=BHSNSH
- S BHSDDC="?"
- I BHSVTP'="C" S BHSHDN=$O(^AUPNVINP("AD",BHSVDF,0)) I BHSHDN S X=+^AUPNVINP(BHSHDN,0) D REGDT4^GMTSU S BHSDDC=X
- I BHSVTP="C" S BHSCDN=$O(^AUPNVCHS("AD",BHSVDF,0)) I BHSCDN S X=$P(^AUPNVCHS(BHSCDN,0),U,7) D REGDT4^GMTSU S BHSDDC=X
- D CKP^GMTSUP Q:$D(GMTSQIT) D IHDR
- S BHSPDN="" F BHSQ=0:0 S BHSPDN=$O(^AUPNVPOV("AD",BHSVDF,BHSPDN)) Q:'BHSPDN S BHSN=^AUPNVPOV(BHSPDN,0) D DSPPOV
- W:$X ?33,"<no visit data>",!
- Q
- ;
- DSPPOV S BHSICD=$P(BHSN,U,1) D GETICDDX^BHSUTL
- S BHSNRQ=$P(BHSN,U,4)
- D GETNARR^BHSUTL
- S BHSMOD=$P(BHSN,U,6)
- I BHSMOD]"" S BHSMTX=$P(^DD(9000010.07,.06,0),U,3),BHSMTX=$P($P(BHSMTX,BHSMOD_":",2),";",1),BHSMTX=$P(BHSMTX,",",1),BHSICD=BHSMTX_" "_BHSICD
- S:$D(^AUPNVCHS("AD",BHSVDF)) BHSNTE="*** CHS ***"
- D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG IHDR S BHSICL=33 S:0 BHSICD=BHSVSC_":"_BHSICD D PRTICD^BHSUTL
- Q
- ;
- IHDR W BHSDAT,"-",BHSDDC,?18,BHSFAC
- Q
- BHSHOS ;IHS/CIA/MGH - Health Summary for hospitalization encounters ;17-Mar-2006 10:36;MGH
- +1 ;;1.0;HEALTH SUMMARY COMPONENTS;;March 17, 2006
- +2 ;===================================================================
- +3 ;Taken from APCHS2C
- +4 ; IHS/TUCSON/LAB - PART 2C OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
- +5 ;;2.0;IHS RPMS/PCC Health Summary;;JUN 24, 1997
- +6 ;VA verision of IHS health summary component for hospitalization encounters
- INPT ; ********** HOSPITALIZATION ENCOUNTERS * 9000010/900010.07 **********
- +1 ; <SETUP>
- +2 NEW BHSPAT,BHSQ,BHSNTE
- +3 SET BHSPAT=DFN
- +4 IF '$DATA(^AUPNVSIT("AAH",BHSPAT))
- QUIT
- +5 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +6 ; <DISPLAY>
- +7 SET BHSPVD=0
- +8 SET BHSIVD=""
- FOR BHSQ=0:0
- SET BHSIVD=$ORDER(^AUPNVSIT("AAH",BHSPAT,BHSIVD))
- IF BHSIVD=""!(BHSIVD>GMTSDLM)
- QUIT
- Begin DoDot:1
- +9 DO ONEDATE
- IF $DATA(GMTSQIT)
- QUIT
- IF BHSDAT'=BHSPVD
- SET GMTSNDM=GMTSNDM-1
- SET BHSPVD=BHSDAT
- IF GMTSNDM=0
- QUIT
- End DoDot:1
- +10 ; <CLEANUP>
- INPTX KILL BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSFO,BHSMTX,BHSMOD,BHSPVD,BHSHDN,BHSDDC,BHSCDN,BHSICD,BHSICL,BHSN,BHSNRQ,BHSPDN,BHSVTP
- +1 KILL BHSNFL,BHSNSH,BHSNAB,BHSVSC,BHSITE,Y,X
- +2 QUIT
- ONEDATE SET X=-BHSIVD\1+9999999
- DO REGDT4^GMTSU
- SET BHSDAT=X
- SET BHSDTU=(BHSDAT=BHSPVD)
- +1 SET BHSVDF=""
- FOR BHSQ=0:0
- SET BHSVDF=$ORDER(^AUPNVSIT("AAH",BHSPAT,BHSIVD,BHSVDF))
- IF BHSVDF=""
- QUIT
- SET BHSN=^AUPNVSIT(BHSVDF,0)
- DO GETSITEV^BHSUTL
- IF "H"[BHSVSC
- DO HOSP
- IF $DATA(GMTSQIT)
- QUIT
- +2 QUIT
- +3 ;
- HOSP ;
- +1 IF $PIECE(BHSN,U,9)=0!($PIECE(BHSN,U,11)=1)
- QUIT
- +2 SET BHSVTP=$PIECE(BHSN,U,3)
- +3 SET BHSDTU=1
- +4 SET BHSFAC=BHSNSH
- +5 SET BHSDDC="?"
- +6 IF BHSVTP'="C"
- SET BHSHDN=$ORDER(^AUPNVINP("AD",BHSVDF,0))
- IF BHSHDN
- SET X=+^AUPNVINP(BHSHDN,0)
- DO REGDT4^GMTSU
- SET BHSDDC=X
- +7 IF BHSVTP="C"
- SET BHSCDN=$ORDER(^AUPNVCHS("AD",BHSVDF,0))
- IF BHSCDN
- SET X=$PIECE(^AUPNVCHS(BHSCDN,0),U,7)
- DO REGDT4^GMTSU
- SET BHSDDC=X
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- DO IHDR
- +9 SET BHSPDN=""
- FOR BHSQ=0:0
- SET BHSPDN=$ORDER(^AUPNVPOV("AD",BHSVDF,BHSPDN))
- IF 'BHSPDN
- QUIT
- SET BHSN=^AUPNVPOV(BHSPDN,0)
- DO DSPPOV
- +10 IF $X
- WRITE ?33,"<no visit data>",!
- +11 QUIT
- +12 ;
- DSPPOV SET BHSICD=$PIECE(BHSN,U,1)
- DO GETICDDX^BHSUTL
- +1 SET BHSNRQ=$PIECE(BHSN,U,4)
- +2 DO GETNARR^BHSUTL
- +3 SET BHSMOD=$PIECE(BHSN,U,6)
- +4 IF BHSMOD]""
- SET BHSMTX=$PIECE(^DD(9000010.07,.06,0),U,3)
- SET BHSMTX=$PIECE($PIECE(BHSMTX,BHSMOD_":",2),";",1)
- SET BHSMTX=$PIECE(BHSMTX,",",1)
- SET BHSICD=BHSMTX_" "_BHSICD
- +5 IF $DATA(^AUPNVCHS("AD",BHSVDF))
- SET BHSNTE="*** CHS ***"
- +6 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- DO IHDR
- SET BHSICL=33
- IF 0
- SET BHSICD=BHSVSC_":"_BHSICD
- DO PRTICD^BHSUTL
- +7 QUIT
- +8 ;
- IHDR WRITE BHSDAT,"-",BHSDDC,?18,BHSFAC
- +1 QUIT
