Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BHSPHN

BHSPHN.m

Go to the documentation of this file. 
  1. BHSPHN ;IHS/CIA/MGH - Health Summary for PUBLIC HEALTH NURSING file ;24-Aug-2012 14:24;DU
  1.  ;;1.0;HEALTH SUMMARY COMPONENTS;**7**;March 17, 2006;Build 12
  1.  ;===================================================================
  1.  ;Taken from APCHS2G
  1.  ;IHS/TUCSON/LAB - PART 2B OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
  1.  ;;2.0;IHS RPMS/PCC Health Summary;**3**;JUN 24, 1997
  1.  ;Routines to document public health nursing encounters from the visit file
  1.  ;in the VA health summary component
  1. OUTPT ; ********** OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  N BHSPAT,BHSN,BHSNTE,BHSQ,BHSTXT,X
  1.  S BHSPAT=DFN
  1.  Q:'$D(^AUPNVSIT("AA",BHSPAT))
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ; <DISPLAY>
  1.  S BHSPVD=0
  1.  S BHSPFN=""
  1.  F BHSIVD=0:0 S BHSIVD=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)  D  Q:GMTSNDM=0!($D(GMTSQIT))
  1.  . D ONEDATE
  1.  . Q:$D(GMTSQIT)
  1.  . S:(BHSDAT'=BHSPVD)&BHSDTU GMTSNDM=GMTSNDM-BHSDTU,BHSPVD=BHSDAT
  1.  . Q
  1.  ;
  1. OUTPTX ; <CLEANUP>
  1.  K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSPFN,BHSSCL,BHSMTX,BHSMOD,BHSPVD,BHSOVT,BHSNDT,BHSCLI,BHSPDN,BHSICD,BHSICL,BHSNRQ,BHSPHN
  1.  K BHSNFL,BHSNSH,BHSCCL,BHSNAB,BHSVSC,BHSITE,BHSQIT,BHSDCL,Y
  1.  Q
  1.  ;
  1. ONEDATE ;
  1.  S BHSCCL=""
  1.  S X=-BHSIVD\1+9999999 D REGDT4^GMTSU S BHSDAT=X
  1.  S BHSDTU=0,BHSNDT=(BHSDAT'=BHSPVD)
  1.  S BHSVDF="" F BHSQ=0:0 S BHSVDF=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD,BHSVDF)) Q:BHSVDF=""  D  Q:$D(GMTSQIT)
  1.  . S BHSSCL=""
  1.  . S BHSN=^AUPNVSIT(BHSVDF,0)
  1.  . Q:'$P(BHSN,U,9)
  1.  . Q:$P(BHSN,U,11)
  1.  . Q:'$$PHN(BHSVDF)  ;do not use is phn is not a provider on this visit
  1.  . D GETCLN
  1.  . D GETSITEV^BHSUTL,DSPVIS
  1.  . Q:$D(GMTSQIT)
  1.  . Q
  1.  Q
  1.  ;
  1. GETCLN ;
  1.  ;BHSDCL=set to 34 if Display Clinic is Yes, 23 if No
  1.  I $D(^GMT(142.1,GMTSE,0)),$P(^(0),U,10)="Y" D
  1.  .S BHSDCL=34
  1.  .S BHSCLI=$P(BHSN,U,8) I BHSCLI="" S BHSCCL="<none>" Q
  1.  .S BHSCLI=$P(BHSN,U,8) Q:BHSCLI=""
  1.  .Q:'$D(^DIC(40.7,BHSCLI))
  1.  .I $D(^DIC(40.7,BHSCLI,9999999)),$P(^(9999999),U,1)]"" S BHSCLI=$P(^DIC(40.7,BHSCLI,9999999),U,1),BHSCCL=BHSCLI Q
  1.  .S BHSCLI=$E($P(^DIC(40.7,BHSCLI,0),U,1),1,10)
  1.  .S BHSCCL=BHSCLI
  1.  E  S BHSCLI=" ",BHSDCL=23 Q
  1.  Q
  1. PHN(V) ;if one provider is phn quit on 1 otherwise quit on ""
  1.  I 'V Q ""
  1.  I '$D(^AUPNVSIT(V)) Q ""
  1.  I '$D(^AUPNVPRV("AD",V)) Q ""
  1.  I $$PRIMPROV^APCLV(V,"D")=13!($$PRIMPROV^APCLV(V,"D")=32) Q 1
  1.  Q ""
  1.  ;if include secondary remove lines above about primary
  1.  NEW %,%1,Y,P S Y=0,%1="" F  S Y=$O(^AUPNVPRV("AD",V,Y)) Q:Y'=+Y  S P=$P(^AUPNVPRV(Y,0),U) D
  1.  .I $P(^DD(9000010.06,.01,0),U,2)[200,'$D(^VA(200,P)) Q
  1.  .I $P(^DD(9000010.06,.01,0),U,2)[6,'$D(^DIC(6,P)) Q
  1.  .S %=$$VALI^XBDIQ1($S($P(^DD(9000010.06,.01,0),U,2)[200:200,1:6),P,$S($P(^DD(9000010.06,.01,0),U,2)[200:53.5,1:2)) I % S %=$P($G(^DIC(7,%,9999999)),U)
  1.  .I %=13!(%=32) S %1=1
  1.  Q %1
  1. DSPVIS ;
  1.  S BHSDTU=1
  1.  I $O(^AUPNVPOV("AD",BHSVDF,""))="" D NOPOV Q
  1.  S BHSPDN="" F BHSQ=0:0 S BHSPDN=$O(^AUPNVPOV("AD",BHSVDF,BHSPDN)) Q:'BHSPDN  S BHSN=^AUPNVPOV(BHSPDN,0) D HASPOV
  1.  Q
  1.  ;
  1. NOPOV ;
  1.  S (BHSICD,BHSNRQ)="<purpose of visit not yet entered>",BHSMOD=""
  1.  G COMMON
  1.  ;
  1. HASPOV ;
  1.  S BHSICD=$P(BHSN,U,1) D GETICDDX^BHSUTL
  1.  S BHSNRQ=$P(BHSN,U,4) D GETNARR^BHSUTL I $P(BHSN,U,5)]"" S BHSNRQ=BHSNRQ_"  (Stage: "_$P(BHSN,U,5)_")" ;IHS/CMI/LAB
  1.  S BHSMOD=$P(BHSN,U,6)
  1. COMMON ;
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  S:GMTSNPG BHSNDT=1
  1.  I BHSNDT W !,BHSDAT S (BHSPFN,BHSSCL)="",BHSNDT=0
  1.  I BHSNSH=BHSPFN S BHSFAC=""
  1.  E  S (BHSFAC,BHSPFN)=BHSNSH,BHSSCL=""
  1.  I BHSCCL=BHSSCL S BHSCLI=""
  1.  E  S (BHSCLI,BHSSCL)=BHSCCL
  1.  I BHSICD["<purpose of visit not"&(BHSSCL="<none>") S BHSCLI=""
  1.  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
  1.  S:$D(^AUPNVCHS("AD",BHSVDF)) BHSNTE="*** CHS ***"
  1.  W ?12,BHSFAC W:BHSCLI]"" ?23,BHSCLI
  1.  S BHSICL=$S(BHSDCL=34:34,1:24)
  1.  S:0 BHSICD=BHSVSC_":"_BHSICD D PRTICD^BHSUTL
  1.  Q
  1. GOALS(BHSVDF) ;display phn fields
  1.  Q:'$D(^AUPNVPHN("AD",BHSVDF))
  1.  S BHSPHN=$O(^AUPNVPHN("AD",BHSVDF,0))
  1.  Q:'BHSPHN
  1.  I $P(^AUPNVPHN(BHSPHN,0),U,5)]"" D CKP^GMTSUP Q:$D(GMTSQIT)  S:GMTSNPG BHSNDT=1 W ?BHSICL,"Intervention: ",$$VAL^XBDIQ1(9000010.32,BHSPHN,.05)
  1.  I $P(^AUPNVPHN(BHSPHN,0),U,6)]"" D CKP^GMTSUP Q:$D(GMTSQIT)  S:GMTSNPG BHSNDT=1 W !?BHSICL,"Complexity: ",$$VAL^XBDIQ1(9000010.32,BHSPHN,.06)
  1.  I $P(^AUPNVPHN(BHSPHN,0),U,5)]""!($P(^AUPNVPHN(BHSPHN,0),U,6)]"") W !
  1.  I $D(^AUPNVPHN(BHSPHN,21)) S BHSTXT="Psycho/Soc/Env: "_^AUPNVPHN(BHSPHN,21),BHSICL=$S(BHSDCL=34:34,1:24)+1 D PRTTXT
  1.  I $D(^AUPNVPHN(BHSPHN,22)) S BHSTXT="NSG Dx: "_^AUPNVPHN(BHSPHN,22),BHSICL=$S(BHSDCL=34:34,1:24)+1 D PRTTXT
  1.  I $D(^AUPNVPHN(BHSPHN,23)) S BHSTXT="Short Term Goals: "_^AUPNVPHN(BHSPHN,23),BHSICL=$S(BHSDCL=34:34,1:24)+1 D PRTTXT
  1.  I $D(^AUPNVPHN(BHSPHN,24)) S BHSTXT="Long Term Goals: "_^AUPNVPHN(BHSPHN,24),BHSICL=$S(BHSDCL=34:34,1:24)+1 D PRTTXT
  1.  Q
  1.  ;
  1. DETAIL ; ********** PHN OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  N BHSPAT,BHSN,BHSNTE,BHSQ,BHSTXT,X
  1.  S BHSPAT=DFN
  1.  Q:'$D(^AUPNVSIT("AA",BHSPAT))
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  ; <DISPLAY>
  1.  S BHSPVD=0
  1.  S BHSPFN=""
  1.  F BHSIVD=0:0 S BHSIVD=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)  D  Q:GMTSNDM=0!($D(GMTSQIT))
  1.  . D ONEVST
  1.  . Q:$D(GMTSQIT)
  1.  . S:(BHSDAT'=BHSPVD)&BHSDTU GMTSNDM=GMTSNDM-BHSDTU,BHSPVD=BHSDAT
  1.  . Q
  1.  ;
  1. CLEAN ; <CLEANUP>
  1.  K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSPFN,BHSSCL,BHSMTX,BHSMOD,BHSPVD,BHSOVT,BHSNDT,BHSCLI,BHSPDN,BHSICD,BHSICL,BHSNRQ,BHSPHN
  1.  K BHSNFL,BHSNSH,BHSCCL,BHSNAB,BHSVSC,BHSITE,BHSQIT,BHSDCL,Y
  1.  Q
  1.  ;
  1. ONEVST ;
  1.  S BHSCCL=""
  1.  S X=-BHSIVD\1+9999999 D REGDT4^GMTSU S BHSDAT=X
  1.  S BHSDTU=0,BHSNDT=(BHSDAT'=BHSPVD)
  1.  S BHSVDF="" F BHSQ=0:0 S BHSVDF=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD,BHSVDF)) Q:BHSVDF=""  D  Q:$D(GMTSQIT)
  1.  . S BHSSCL=""
  1.  . S BHSN=^AUPNVSIT(BHSVDF,0)
  1.  . Q:'$P(BHSN,U,9)
  1.  . Q:$P(BHSN,U,11)
  1.  . Q:'$D(^AUPNVPHN("AD",BHSVDF))
  1.  . S GMTSNDM=GMTSNDM-1
  1.  . D GETCLN
  1.  . D GETSITEV^BHSUTL,DSPVIS
  1.  . D GOALS(BHSVDF)
  1.  . Q:$D(GMTSQIT)
  1.  . Q
  1.  Q
  1. PRTTXT ;Print text
  1.  N BHSQ
  1.  S:'$D(BHSNTE) BHSNTE=""
  1.  S BHSDLT=1,BHSILN=IOM-BHSICL-1
  1.  F BHSQ=0:0 D PRTTXT1 Q:BHSTXT=""  D PRTTXT2
  1.  K BHSNTE
  1.  K BHSILN,BHSDLT,BHSF,BHSC,BHSTXT
  1.  Q
  1. PRTTXT1 ;
  1.  S:($L(BHSTXT)+2)<255 BHSTXT=$S(BHSTXT]"":BHSTXT,1:""),BHSNRQ=""
  1.  S:BHSNTE]""&(($L(BHSTXT)+2)<255) BHSTXT=BHSTXT_BHSNTE,BHSNTE=""
  1.  Q
  1. PRTTXT2 D GETFRAG D CKP^GMTSUP Q:$D(GMTSQIT)  W ?BHSICL W BHSF,! S BHSICL=BHSICL+BHSDLT,BHSILN=BHSILN-BHSDLT,BHSDLT=0
  1.  Q
  1. GETFRAG I $L(BHSTXT)<BHSILN S BHSF=BHSTXT,BHSTXT="" Q
  1.  F BHSC=BHSILN:-1:0 Q:$E(BHSTXT,BHSC)=" "
  1.  S:BHSC=0 BHSC=BHSILN
  1.  S BHSF=$E(BHSTXT,1,BHSC-1),BHSTXT=$E(BHSTXT,BHSC+1,255)
  1.  Q