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

APCHS2H.m

Go to the documentation of this file. 
  1. APCHS2H ; IHS/CMI/LAB - PART 2B OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
  1.  ;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
  1.  ;
  1. OUTPT ; ********** OUTPATIENT ENCOUNTERS WITHOUT CHR * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVSIT("AA",APCHSPAT))
  1.  S APCHSOVT="ARSCOTE" ; NOTE: THIS CONTROLS TYPES OF VISITS DISPLAYED
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSPVD=0
  1.  S APCHSPFN=""
  1.  S APCHSDCX="",APCHSDPR=""
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,3)="Y" S APCHSDCX=1
  1.  I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,5)=1 S APCHSDPR=1
  1.  I 'APCHSDPR,'APCHSDCX S APCHSDCL=23
  1.  I APCHSDCX,'APCHSDPR S APCHSDCL=32
  1.  I APCHSDCX,APCHSDPR S APCHSDCL=35
  1.  I 'APCHSDCX,APCHSDPR S APCHSDCL=28
  1.  F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  D  Q:APCHSNDM=0!(APCHSQT)
  1.  .  S APCHSQT=1
  1.  .  D ONEDATE
  1.  .  Q:$D(APCHSQIT)
  1.  .  S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT
  1.  .  S APCHSQT=0
  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
  1.  K APCHSNFL,APCHSNSH,APCHSCCL,APCHSNAB,APCHSVSC,APCHSITE,APCHSQT,APCHSDCL,Y,APCHSDCX,APCHSDPR,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:APCHSQT
  1.  .  S APCHSQT=1
  1.  .  S APCHSSCL=""
  1.  .  S APCHSN=^AUPNVSIT(APCHSVDF,0)
  1.  .  I +$P(APCHSN,U,9),'$P(APCHSN,U,11) D GETCLN,GETPROV,GETSITEV^APCHSUTL D
  1.  .. Q:$$PRIMPROV^APCLV(APCHSVDF,"D")=53  ;exclude chr prim prov 
  1.  .. I $P(APCHSN,U,7)="E",'$D(^AUPNVPOV("AD",APCHSVDF)) S APCHSQT=0 Q  ;don't display events with no pov
  1.  ..  I APCHSOVT[APCHSVSC D DSPVIS
  1.  ..  Q
  1.  .  Q:$D(APCHSQIT)
  1.  .  S APCHSQT=0
  1.  .  Q
  1.  Q
  1.  ;
  1. GETPROV ;
  1.  S APCHSPRV=$$PRIMPROV^APCLV(APCHSVDF,"T")
  1.  Q
  1. GETCLN ;
  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,8)
  1.  S APCHSCCL=APCHSCLI
  1.  Q
  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=$P(APCHSN,U,4) D
  1.  .I $$WANTPN^APCHSUTL(APCHSTYP) S APCHSNRQ=$$GET1^DIQ(9000010.07,APCHSPDN_",",.04)
  1.  .I $P(APCHSN,U,29)]"" S APCHSNRQ=APCHSNRQ_" ["_$$VAL^XBDIQ1(9000010.07,APCHSPDN,.29)_"]" ;IHS/CMI/LAB V2.0 PATCH 15
  1.  .I $P(APCHSN,U,5)]"" S APCHSNRQ=APCHSNRQ_"  (Stage: "_$P(APCHSN,U,5)_")"
  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.  W ?10,APCHSFAC
  1.  I APCHSDCX,APCHSDPR W ?23,$E(APCHSCLI,1,6),?30,APCHSPRV
  1.  I APCHSDCX,'APCHSDPR W ?23,APCHSCLI
  1.  I 'APCHSDCX,APCHSDPR W ?23,APCHSPRV
  1.  S APCHSICL=APCHSDCL
  1.  S:0 APCHSICD=APCHSVSC_":"_APCHSICD D PRTICD^APCHSUTL
  1.  Q
  1. INHOSP ; ********** INHOSPITAL ENCOUNTERS * 9000010/9000010.07 **********
  1.  ; <SETUP>
  1.  Q:'$D(^AUPNVSIT("AA",APCHSPAT))
  1.  S APCHSOVT="I" ; NOTE: This controls types of visits displayed
  1.  X APCHSCKP Q:$D(APCHSQIT)  X:'APCHSNPG APCHSBRK
  1.  ; <DISPLAY>
  1.  S APCHSPVD=0
  1.  F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  D ONEDATE Q:$D(APCHSQIT)  S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT Q:APCHSNDM=0
  1.  ; <CLEANUP>
  1. INHOSPX K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ
  1.  K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y
  1.  Q
  1.  ;