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

APCHPWHU.m

Go to the documentation of this file. 
  1. APCHPWHU ; IHS/CMI/LAB - PCC HEALTH SUMMARY ;
  1.  ;;2.0;IHS PCC SUITE;**6,7,11**;MAY 14, 2009;Build 58
  1.  ;
  1. SUBHEAD ;EP - print subheader
  1.  NEW X
  1.  S X=$TR($J("",(IOM-10))," ","_")
  1.  D S^APCHPWH1(X,1)
  1.  ;S X=$S($P(^APCHPWHC(APCHSCMP,0),U,4)]"":$P(^APCHPWHC(APCHSCMP,0),U,4),1:$P(^APCHPWHC(APCHSCMP,0),U))_" - "
  1.  ;D S^APCHPWH1(X)
  1.  Q
  1. WRITET(TEXT) ;EP
  1.  NEW X,Y
  1.  S X=$O(^APCHPWHI("B",TEXT,0))
  1.  I X="" Q
  1.  S Y=0 F  S Y=$O(^APCHPWHI(X,11,Y)) Q:Y'=+Y  D S^APCHPWH1(^APCHPWHI(X,11,Y,0))
  1.  Q
  1. WRITEF(FORM,TEXT) ;EP
  1.  NEW X,Y
  1.  S X=$O(^APCHPWHF(FORM,11,"B",TEXT,0))
  1.  I X="" Q
  1.  S Y=0 F  S Y=$O(^APCHPWHF(FORM,11,X,11,Y)) Q:Y'=+Y  D S^APCHPWH1(^APCHPWHF(FORM,11,X,11,Y,0))
  1.  Q
  1. EHR(DFN,APCHPWHT)  ;*16*  CMI/GRL support for EHR
  1.  D EN^XBNEW("PRINT^APCHPWHG","DFN;APCHSTYP")
  1.  Q
  1.  ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;---------- 
  1.  ;
  1. UPDLOG(P,T,D) ;EP - update pwh log
  1.  I $G(P)="" Q
  1.  I $G(T)="" Q
  1.  NEW DIC,X,DD,DO,D0
  1.  S X=P,DIC="^APCHPWHL(",DIC(0)="L",DIADD=1,DLAYGO=9001027
  1.  S DIC("DR")=".02////"_T_";.03////"_D_";.04////"_DT_";.05///"_$$NOW^XLFDT_";.06////"_DUZ(2)
  1.  K DD,D0,D0
  1.  D FILE^DICN
  1.  Q
  1.  ;
  1. UPDDEF ;EP - called from option to update default PWH for the site
  1.  W !!,"This option is used to set the default Patient Wellness Handout"
  1.  W !,"for a site."
  1.  W !!
  1.  K DIC S DIC="^APCCCTRL(",DIC("B")=$P(^DIC(4,DUZ(2),0),U),DIC(0)="AEMQ" D ^DIC K DIC
  1.  I Y=-1 Q
  1.  S DA=+Y,DIE="^APCCCTRL(",DR=".16" D ^DIE
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. CPT(P,BDATE,EDATE,T,F,SCEX) ;EP - return ien of CPT entry if patient had this CPT
  1.  I '$G(P) Q ""
  1.  I '$G(T) Q ""
  1.  I '$G(F) S F=1
  1.  S SCEX=$G(SCEX)
  1.  I $G(EDATE)="" Q ""
  1.  I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  ;go through visits in a date range for this patient, check cpts
  1.  NEW D,BD,ED,X,Y,D,G,V
  1.  S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
  1.  F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:'$D(^AUPNVCPT("AD",V))
  1.  ..I SCEX]"",SCEX[$P(^AUPNVSIT(V,0),U,7) Q
  1.  ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G)  D
  1.  ...I $$ICD^ATXAPI($P(^AUPNVCPT(X,0),U),T,1) S G=X
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I 'G Q ""
  1.  I F=1 Q $S(G:1,1:"")
  1.  I F=2 Q G
  1.  I F=3 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
  1.  I F=4 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
  1.  I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P($$CPT^ICPTCOD($P(^AUPNVCPT(G,0),U)),U,2)
  1.  I F=6 S V=$P(^AUPNVCPT(G,0),U,3) I V Q 1_"^"_$P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P($$CPT^ICPTCOD($P(^AUPNVCPT(G,0),U)),U,2)_"^"_G
  1.  Q ""
  1.  ;
  1. RAD(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT
  1.  I '$G(P) Q ""
  1.  I '$G(T) Q ""
  1.  I '$G(F) S F=1
  1.  I $G(EDATE)="" Q ""
  1.  I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  ;go through visits in a date range for this patient, check cpts
  1.  NEW D,BD,ED,X,Y,D,G,V,C
  1.  S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
  1.  F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:'$D(^AUPNVRAD("AD",V))
  1.  ..S X=0 F  S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X!(G)  D
  1.  ...S C=$P(^AUPNVRAD(X,0),U) Q:C=""  S C=$P($G(^RAMIS(71,C,0)),U,9) Q:C=""
  1.  ...I $$ICD^ATXAPI(C,T,1) S G=X
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I 'G Q ""
  1.  I F=1 Q $S(G:1,1:"")
  1.  I F=2 Q G
  1.  I F=3 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
  1.  I F=4 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
  1.  I F=5 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U,9)
  1.  I F=6 S V=$P(^AUPNVRAD(G,0),U,3) I V Q 1_"^"_$P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^RAMIS(71,$P(^AUPNVRAD(G,0),U),0),U)_"^"_G
  1.  Q ""
  1.  ;
  1. TRAN(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT IN A TRAN CODE
  1.  I '$G(P) Q ""
  1.  I '$G(T) Q ""
  1.  I '$G(F) S F=1
  1.  I $G(EDATE)="" Q ""
  1.  I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)
  1.  ;go through visits in a date range for this patient, check cpts
  1.  NEW D,BD,ED,X,Y,D,G,V
  1.  S ED=(9999999-EDATE),BD=9999999-BDATE,G=0
  1.  F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:'$D(^AUPNVTC("AD",V))
  1.  ..S X=0 F  S X=$O(^AUPNVTC("AD",V,X)) Q:X'=+X!(G)  D
  1.  ...I $$ICD^ATXAPI($P(^AUPNVTC(X,0),U,7),T,1) S G=X
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  I 'G Q ""
  1.  I F=1 Q $S(G:1,1:"")
  1.  I F=2 Q G
  1.  I F=3 S V=$P(^AUPNVTC(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
  1.  I F=4 S V=$P(^AUPNVTC(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
  1.  I F=5 S V=$P(^AUPNVTC(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P($$CPT^ICPTCOD($P(^AUPNVTC(G,0),U,7)),U,2)
  1.  I F=6 S V=$P(^AUPNVTC(G,0),U,3) I V Q 1_"^"_$P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P($$CPT^ICPTCOD($P(^AUPNVTC(G,0),U,7)),U,2)_"^"_G
  1.  Q ""
  1.  ;