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

APCHPWH1.m

Go to the documentation of this file. 
  1. APCHPWH1 ; IHS/CMI/LAB - Patient Wellness Handout ; 11 Oct 2011  5:44 PM
  1.  ;;2.0;IHS PCC SUITE;**2,7,11**;MAY 14, 2009;Build 58
  1.  ;
  1. S(Y,F,C,T) ;EP - set up array
  1.  I '$G(F) S F=0
  1.  I '$G(T) S T=0
  1.  NEW %,X
  1.  ;blank lines
  1.  F F=1:1:F S X="" D S1
  1.  S X=Y
  1.  I $G(C) S L=$L(Y),T=(80-L)/2 D  D S1 Q
  1.  .F %=1:1:(T-1) S X=" "_X
  1.  F %=1:1:T S X=" "_X
  1.  D S1
  1.  Q
  1. S1 ;
  1.  S %=$P($G(^TMP($J,"APCHPWH",0)),U)+1,$P(^TMP($J,"APCHPWH",0),U)=%
  1.  S ^TMP($J,"APCHPWH",%)=X
  1.  Q
  1.  ;
  1. EP(APCHSDFN,APCHPWHT,APCHPRTH) ;PEP - PASS DFN get back array of patient wellness handout
  1.  ;handout returned in ^TMP("APCHPHS",$J,"APCHPWH"
  1.  ;APCHPWHT - ien of the PWH type
  1.  ;APCHPRTH - 1 if you don't want the header line printed
  1.  K ^TMP($J,"APCHPWH")
  1.  S ^TMP($J,"APCHPWH",0)=0
  1.  I '$G(APCHPWHT) S APCHPWHT=$O(^APCHPWHT("B","ADULT REGULAR",0))
  1.  I '$G(APCHPWHT) Q
  1.  D SETARRAY
  1.  Q
  1. SETARRAY ;set up array containing pwh
  1.  ;all handouts get this demographic section, the opening text is dependent on the age of the patient
  1.  NEW X,APCHPRV,APCHSO,APCHSCMP,APCHSCMI
  1.  I '$G(APCHPRTH) S X="My Wellness Handout",$E(X,40)="Report Date:  "_$$FMTE^XLFDT(DT) D S(X)
  1.  S X="********** CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"]  "_$$FMTE^XLFDT(DT)_" **********" D S(X)
  1.  ;S X=$P($P(^DPT(APCHSDFN,0),U),",",2)_" "_$P($P(^DPT(APCHSDFN,0),U),",")_"   HRN:  "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2)),$E(X,50)=$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U)) D S(X,1)
  1.  S X=$P(^DPT(APCHSDFN,0),U)_"   HRN:  "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2)),$E(X,50)=$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U)) D S(X,1)
  1.  S X=$$VAL^XBDIQ1(2,APCHSDFN,.111)
  1.  I $P($G(^APCCCTRL(DUZ(2),0)),U,18)]"" D  I 1
  1.  .S $E(X,50)=$P(^APCCCTRL(DUZ(2),0),U,18)_$S($P(^APCCCTRL(DUZ(2),0),U,18)]"":", ",1:" ")_$S($P($G(^APCCCTRL(DUZ(2),0)),U,19):$P(^DIC(5,$P(^APCCCTRL(DUZ(2),0),U,19),0),U,2),1:"")_"  "_$P(^APCCCTRL(DUZ(2),0),U,21) D S(X)
  1.  E  S $E(X,50)=$$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_$S($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)]"":", ",1:" ")_$S($P($G(^AUTTLOC(DUZ(2),0)),U,16):$P(^DIC(5,$$VALI^XBDIQ1(9999999.06,DUZ(2),.16),0),U,2),1:"") D
  1.  .S X=X_"  "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17) D S(X)
  1.  S X=$$VAL^XBDIQ1(2,APCHSDFN,.114)_$S($$VAL^XBDIQ1(2,APCHSDFN,.114)]"":",  ",1:" ")_$$VAL^XBDIQ1(2,APCHSDFN,.115)_"   "_$$VAL^XBDIQ1(2,APCHSDFN,.116)
  1.  S APCHPRV=$$DPCP(APCHSDFN)
  1.  I APCHPRV D
  1.  .S $E(X,50)=$P(^VA(200,APCHPRV,0),U) D S(X)
  1.  I 'APCHPRV D S(X)
  1.  S X=$$VAL^XBDIQ1(2,APCHSDFN,.131),$E(X,50)=$P(^AUTTLOC(DUZ(2),0),U,11) D S(X)  ;put provider phone at 50
  1.  ;I $G(APCDVSIT)]"",$D(^AUPNVSIT("AC",APCHSDFN,APCDVSIT)) S APCHPROV=$$PRIMPROV^APCLV(APCDVSIT)
  1.  ;S X="Hello "_$S($$SEX^AUPNPAT(APCHSDFN)="M":"Mr. ",1:"Ms. ")_$E($P($P(^DPT(APCHSDFN,0),U),","))_$$LOW^XLFSTR($E($P($P(^DPT(APCHSDFN,0),U),","),2,99))_"," D S(X,1)
  1.  I $$AGE^AUPNPAT(APCHSDFN)>12 D  I 1
  1.  .S X="Thank you for choosing "_$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U))_"." D S(X,1)
  1.  .S X="This handout is a new way for you and your doctor to look at your health." D S(X)
  1.  E  D
  1.  .S X="Thank you for visiting with us!" D S(X,1)
  1.  .S X="Please look at this information about your child's visit.  If you have any" D S(X)
  1.  .S X="questions, contact your child's health care provider or ask at your next" D S(X)
  1.  .S X="clinic appointment." D S(X)
  1.  D EMERG
  1.  ;now process each component assigned to this type
  1.  ;
  1. COMPS ;
  1.  ;I $$AGE^AUPNPAT(APCHSDFN)<18 D S("This handout is designed for patients 18 years of age and older.",2) Q
  1.  S APCHSORD=0 F  S APCHSORD=$O(^APCHPWHT(APCHPWHT,1,APCHSORD)) Q:APCHSORD'=+APCHSORD  D
  1.  .S APCHSCMP=$P(^APCHPWHT(APCHPWHT,1,APCHSORD,0),U,2)
  1.  .Q:'APCHSCMP
  1.  .Q:'$D(^APCHPWHC(APCHSCMP,0))
  1.  .Q:$P(^APCHPWHC(APCHSCMP,0),U,2)  ;INACTIVE
  1.  .S APCHSCMI=$P(^APCHPWHC(APCHSCMP,0),U,2)
  1.  .D @($P(APCHSCMI,";",1)_U_$P(APCHSCMI,";",2))
  1.  S X="******** END CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"]  "_$$FMTE^XLFDT(DT)_" ********" D S(X,2)
  1.  Q
  1.  ;
  1. DPCP(P) ;EP
  1.  NEW R
  1.  D ALLDP^BDPAPI(P,"DESIGNATED PRIMARY PROVIDER",.R)
  1.  I $D(R("DESIGNATED PRIMARY PROVIDER")) Q $P(R("DESIGNATED PRIMARY PROVIDER"),U,2)
  1.  S R=$P(^AUPNPAT(P,0),U,14) I R Q R
  1.  S R=""
  1.  Q R
  1.  ;
  1. HELP1 ;EP - called from help prompt of structure multiple
  1.  D EN^DDIOL("This field contains a number which specifies the relative order in which")
  1.  D EN^DDIOL("the related component will appear on the Patient Wellness Handout.")
  1.  D EN^DDIOL("The values for this field (i.e., for separte entries in the STRUCTURE")
  1.  D EN^DDIOL("multiple) need not be sequential, and need not be entered in sequence.")
  1.  D EN^DDIOL("For example, if entered in the order 5 10 7 15, the related components")
  1.  D EN^DDIOL("will appear in the order 5 7 10 15.")
  1.  Q
  1. HELP2 ;EP - called from help prompt of measure multiple
  1.  D EN^DDIOL("This field contains a number which specifies the relative order in which")
  1.  D EN^DDIOL("the related MEASURE will appear within the QUALITY OF CARE TRANSPARENCY")
  1.  D EN^DDIOL("REPORT CARD component.  The values for this field (i.e., for separate")
  1.  D EN^DDIOL("entries in the SEQUENCE multiple) need not be sequential, and need not")
  1.  D EN^DDIOL("be entered in sequence.  For example, if entered in the order 5 10 7 15,")
  1.  D EN^DDIOL("the related components will appear in the order 5 7 10 15.")
  1.  Q
  1. EMERG ;EP - emergency contact component
  1.  D SUBHEAD^APCHPWHU
  1.  S X="Emergency Contact:  "_$$VAL^XBDIQ1(2,APCHSDFN,.331),$E(X,60)="My Blood Type:  "_$$BLOODTYP(APCHSDFN) D S(X)
  1.  D S("Address:  "_$$VAL^XBDIQ1(2,APCHSDFN,.333))
  1.  D S("City/State:  "_$$VAL^XBDIQ1(2,APCHSDFN,.336)_$S($$VAL^XBDIQ1(2,APCHSDFN,.337)]"":", ",1:"")_$$VAL^XBDIQ1(2,APCHSDFN,.337)_"  "_$$VAL^XBDIQ1(2,APCHSDFN,.338))
  1.  D S("Phone:  "_$$VAL^XBDIQ1(2,APCHSDFN,.339))
  1.  D S(" ")
  1.  S Y=$$LASTER(APCHSDFN)
  1.  I Y D
  1.  .S X="Last ER visit: "_$$FMTE^XLFDT($$VD^APCLV(Y)) D S(X)
  1.  .S X="   Main reason for the visit: "_$$PRIMPOV^APCLV(Y,"E") D S(X)
  1.  S Y=$$LASTHOSP(APCHSDFN)
  1.  I Y D
  1.  .D S("Last Hospital Admission: "_$$FMTE^XLFDT($$VD^APCLV(Y)))
  1.  .D S("   Reason for admission: "_$$PRIMPOV^APCLV(Y,"E"))
  1.  Q
  1. BLOODTYP(P) ;EP - get blood type for patient P
  1.  NEW B,L
  1.  S B=""
  1.  I $D(^DPT(P,"LR")) D
  1.  .S L=^DPT(P,"LR")   ; get pt's LRDFN get Blood Bank blood type 
  1.  .Q:L=""
  1.  .Q:'$D(^LR(L,0))
  1.  .S B=$P(^LR(L,0),U,5)
  1.  I B]"" Q B
  1.  Q $$VAL^XBDIQ1(9000001,P,.13)
  1. LASTER(P) ;LAST VISIT TO CLINIC 30
  1.  ;find last ER visit
  1.  NEW B,D,V,G
  1.  S G="",B=(9999999-DT)+1
  1.  F  S B=$O(^AUPNVSIT("AA",P,B)) Q:B=""!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",P,B,V)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..Q:$P(^AUPNVSIT(V,0),U,11)
  1.  ..Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  ..Q:$$CLINIC^APCLV(V,"C")'=30
  1.  ..;Q:'$D(^AUPNVPOV("AD",V))
  1.  ..;Q:'$D(^AUPNVPRV("AD",V))
  1.  ..S G=V
  1.  Q G
  1. LASTHOSP(P) ;LAST HOSP VISIT
  1.  ;find last H visit
  1.  NEW B,D,V,G
  1.  S G="",B=(9999999-DT)+1
  1.  F  S B=$O(^AUPNVSIT("AAH",P,B)) Q:B=""!(G)  D
  1.  .S V=$O(^AUPNVSIT("AAH",P,B,0)) Q:V'=+V!(G)  D
  1.  ..Q:'$D(^AUPNVSIT(V,0))
  1.  ..S G=V
  1.  Q G