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

APCHS2G.m

Go to the documentation of this file. 
  1. APCHS2G ; IHS/CMI/LAB - PART 2B OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;
  1. OUTPT ; ********** OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVSIT("AA",APCHSPAT))
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSPVD=0
  1.  S APCHSPFN=""
  1.  F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  D  Q:APCHSNDM=0!($D(APCHSQIT))
  1.  . D ONEDATE
  1.  . Q:$D(APCHSQIT)
  1.  . S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT
  1.  . Q
  1.  ;
  1. OUTPTX ; <CLEANUP>
  1.  K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ,APCHSPHN
  1.  K APCHSNFL,APCHSNSH,APCHSCCL,APCHSNAB,APCHSVSC,APCHSITE,APCHSQIT,APCHSDCL,Y,APCHCSVD
  1.  Q
  1.  ;
  1. ONEDATE ;
  1.  S APCHSCCL=""
  1.  S (Y,APCHCSVD)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
  1.  S APCHSDTU=0,APCHSNDT=(APCHSDAT'=APCHSPVD)
  1.  S APCHSVDF="" F APCHSQ=0:0 S APCHSVDF=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD,APCHSVDF)) Q:APCHSVDF=""  D  Q:$D(APCHSQIT)
  1.  . S APCHSSCL=""
  1.  . S APCHSN=^AUPNVSIT(APCHSVDF,0)
  1.  . Q:'$P(APCHSN,U,9)
  1.  . Q:$P(APCHSN,U,11)
  1.  . Q:'$$PHN(APCHSVDF)  ;do not use if phn is not a provider on this visit
  1.  . D GETCLN,GETSITEV^APCHSUTL,DSPVIS
  1.  . Q:$D(APCHSQIT)
  1.  . Q
  1.  Q
  1.  ;
  1. GETCLN ;
  1.  ;APCHSDCL=set to 34 if Display Clinic is Yes, 23 if No
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,3)="Y"
  1.  E  S APCHSCLI=" ",APCHSDCL=23 Q
  1.  S APCHSDCL=34
  1.  S APCHSCLI=$P(APCHSN,U,8) I APCHSCLI="" S APCHSCCL="<none>" Q
  1.  S APCHSCLI=$P(APCHSN,U,8) Q:APCHSCLI=""
  1.  Q:'$D(^DIC(40.7,APCHSCLI))
  1.  I $D(^DIC(40.7,APCHSCLI,9999999)),$P(^(9999999),U,1)]"" S APCHSCLI=$P(^DIC(40.7,APCHSCLI,9999999),U,1),APCHSCCL=APCHSCLI Q
  1.  S APCHSCLI=$E($P(^DIC(40.7,APCHSCLI,0),U,1),1,10)
  1.  S APCHSCCL=APCHSCLI
  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 APCHSDTU=1
  1.  I $O(^AUPNVPOV("AD",APCHSVDF,""))="" D NOPOV Q
  1.  S APCHSPDN="" F APCHSQ=0:0 S APCHSPDN=$O(^AUPNVPOV("AD",APCHSVDF,APCHSPDN)) Q:'APCHSPDN  S APCHSN=^AUPNVPOV(APCHSPDN,0) D HASPOV
  1.  Q
  1.  ;
  1. NOPOV ;
  1.  S (APCHSICD,APCHSNRQ)="<purpose of visit not yet entered>",APCHSMOD=""
  1.  G COMMON
  1.  ;
  1. HASPOV ;
  1.  S APCHSICD=$P(APCHSN,U,1) D GETICDDX^APCHSUTL
  1.  S APCHSNRQ=$$VAL^XBDIQ1(9000010.07,APCHSPDN,.04) I $P(APCHSN,U,5)]"" S APCHSNRQ=APCHSNRQ_"  (Stage: "_$P(APCHSN,U,5)_")" ;IHS/CMI/LAB
  1.  S APCHSMOD=$P(APCHSN,U,6)
  1. COMMON ;
  1.  X APCHSCKP Q:$D(APCHSQIT)  S:APCHSNPG APCHSNDT=1
  1.  I APCHSNDT W APCHSDAT S (APCHSPFN,APCHSSCL)="",APCHSNDT=0
  1.  I APCHSNSH=APCHSPFN S APCHSFAC=""
  1.  E  S (APCHSFAC,APCHSPFN)=APCHSNSH,APCHSSCL=""
  1.  I APCHSCCL=APCHSSCL S APCHSCLI=""
  1.  E  S (APCHSCLI,APCHSSCL)=APCHSCCL
  1.  I APCHSICD["<purpose of visit not"&(APCHSSCL="<none>") S APCHSCLI=""
  1.  I APCHSMOD]"" S APCHSMTX=$P(^DD(9000010.07,.06,0),U,3),APCHSMTX=$P($P(APCHSMTX,APCHSMOD_":",2),";",1),APCHSMTX=$P(APCHSMTX,",",1),APCHSICD=APCHSMTX_" "_APCHSICD
  1.  S:$D(^AUPNVCHS("AD",APCHSVDF)) APCHSNTE="*** CHS ***"
  1.  ;S APCHSICL=$S(APCHSCLI'=" ":34,1:23)
  1.  W ?10,APCHSFAC W:APCHSCLI]"" ?23,APCHSCLI
  1.  S APCHSICL=$S(APCHSDCL=34:34,1:24)
  1.  S:0 APCHSICD=APCHSVSC_":"_APCHSICD D PRTICD^APCHSUTL
  1.  ;display phn fields
  1.  Q:'$D(^AUPNVPHN("AD",APCHSVDF))
  1.  S APCHSPHN=$O(^AUPNVPHN("AD",APCHSVDF,0))
  1.  Q:'APCHSPHN
  1.  I $P(^AUPNVPHN(APCHSPHN,0),U,5)]"" X APCHSCKP Q:$D(APCHSQIT)  S:APCHSNPG APCHSNDT=1 W ?APCHSICL,"Intervention: ",$$VAL^XBDIQ1(9000010.32,APCHSPHN,.05)
  1.  I $P(^AUPNVPHN(APCHSPHN,0),U,6)]"" X APCHSCKP Q:$D(APCHSQIT)  S:APCHSNPG APCHSNDT=1 W !?APCHSICL,"Complexity: ",$$VAL^XBDIQ1(9000010.32,APCHSPHN,.06)
  1.  I $P(^AUPNVPHN(APCHSPHN,0),U,5)]""!($P(^AUPNVPHN(APCHSPHN,0),U,6)]"") W !
  1.  I $D(^AUPNVPHN(APCHSPHN,21)) S APCHSNRQ="Psycho/Soc/Env: "_^AUPNVPHN(APCHSPHN,21),APCHSTXT="",APCHSICL=$S(APCHSDCL=34:34,1:24)+1 D PRTTXT^APCHSUTL
  1.  I $D(^AUPNVPHN(APCHSPHN,22)) S APCHSNRQ="NSG Dx: "_^AUPNVPHN(APCHSPHN,22),APCHSTXT="",APCHSICL=$S(APCHSDCL=34:34,1:24)+1 D PRTTXT^APCHSUTL
  1.  I $D(^AUPNVPHN(APCHSPHN,23)) S APCHSNRQ="Short Term Goals: "_^AUPNVPHN(APCHSPHN,23),APCHSTXT="",APCHSICL=$S(APCHSDCL=34:34,1:24)+1 D PRTTXT^APCHSUTL
  1.  I $D(^AUPNVPHN(APCHSPHN,24)) S APCHSNRQ="Long Term Goals: "_^AUPNVPHN(APCHSPHN,24),APCHSTXT="",APCHSICL=$S(APCHSDCL=34:34,1:24)+1 D PRTTXT^APCHSUTL
  1.  Q
  1.  ;