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

AMHESIG.m

Go to the documentation of this file. 
  1. AMHESIG ; IHS/CMI/LAB - ADD NEW MHSS ACTIVITY RECORDS 13 Aug 2007 4:21 PM 11 Jan 2010 5:19 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1.  ;
  1. ESIG(R,G) ;EP - called for esig
  1.  NEW X1,DA,DR,DIE,D
  1.  I '$D(^AMHREC(R,0)) Q "0^0^Invalid VISIT, no Esig required"
  1.  I '$P(^AMHREC(R,0),U,8) Q "0^0"
  1.  I '$$ESIGREQ(R),'$P($G(^AMHREC(R,11)),U,10) Q "0^1^E Sig not required for this visit, visit is prior to Version 4.0 install date."  ;not required
  1.  I $P($G(^AMHREC(R,11)),U,10) Q "0^0^EHR created notes can only be signed in EHR" ;no EHR visits  cmi/maw 9/30/2009 changed text at request of PR 480
  1.  I $P($G(^AMHREC(R,11)),U,12)]"" Q "0^1^Note already signed, no E Sig necessary." ;
  1.  I $$PPINT^AMHUTIL(R)="" Q "0^0^No primary provider to check.  No PCC link."
  1.  I $D(^AMHSITE(DUZ(2),19,"B",$$PPINT^AMHUTIL(R))) Q "0^1^Provider opted out of E Sig, no E Sig required."
  1.  I DUZ'=$$PPINT^AMHUTIL(R) Q "0^0^Only the Primary provider is permitted to sign a note."
  1.  I '$O(^AMHREC(R,31,0)) Q "0^0^A note must be entered before an E Sig can be applied-Visit will not pass to PCC^1"
  1.  I '$G(G),$P(^AMHREC(R,0),U,34) Q "0^0^This is a group encounter.  Must be signed under the Group Options."
  1.  Q "1^1"
  1.  ;
  1. ESIGGFI(AMHR) ;EP
  1.  W !!,"SOAP/Progress Note Electronic Signature"
  1.  D SIG^XUSESIG
  1.  I X1="" Q
  1.  S DIE="^AMHREC(",DA=AMHR,DR="1112///NOW;1113///"_$P($G(^VA(200,DUZ,20)),U,2)_";1116///"_$P(^VA(200,DUZ,20),U,3) D ^DIE K DA,DIE,DR
  1.  I $D(Y) W !!,"Error updating electronic signature...see your supervisor for programmer help."
  1.  K X1
  1.  Q
  1. ESIGREQ(R,D) ;EP - is esig required on this visit?
  1.  NEW SD,G
  1.  S R=$G(R)
  1.  S D=$G(D)
  1.  S SD=$$DATE()
  1.  I SD="" Q 0  ;no start date
  1.  ;
  1.  S G=0
  1.  I D]"" D  Q G
  1.  .I D<SD S G=0 Q
  1.  .S G=1
  1.  I R,$D(^AMHREC(R,0)) S D=$P($P(^AMHREC(R,0),U),".")
  1.  I D,D<SD Q 0
  1.  I $P($G(^AMHREC(R,11)),U,10) Q 0
  1.  Q 1
  1.  ; 
  1. DATE() ;EP - Determine DATE patch 10 was installed
  1.  ;
  1.  NEW P,M,A,D
  1.  S D=""
  1.  S P=$O(^DIC(9.4,"C","AMH",0))
  1.  I P="" Q ""
  1.  S M=$O(^DIC(9.4,P,22,"B","4.0",0))
  1.  I M="" Q ""
  1.  S D=$P($G(^DIC(9.4,P,22,M,0)),U,3)
  1.  Q D
  1.  ;
  1. HELPESIG ;EP - called from help prompt
  1.  W !!,"Enter a date to start prompting for the electronic signature.  "
  1.  W !,"Any visit with a visit date on or after this date will require an electronic"
  1.  W !,"signature.  The date must be equal to greater than ",$$FMTE^XLFDT($$DATE)
  1.  W !," which is the date patch 10 was installed.",!
  1.  Q
  1. ESIGINT(R,G) ;EP - called for esig
  1.  NEW X1,DA,DR,DIE,D
  1.  I '$D(^AMHRINTK(R,0)) Q "0^0^Invalid intake, no Esig required"
  1.  ;I '$$ESIGREQ(R) Q "0^1^E Sig not required for this visit, visit is prior to Version 4.0 install date."  ;not required
  1.  I $P($G(^AMHRINTK(R,0)),U,12)]"" Q "0^1^Note already signed, no E Sig necessary." ;
  1.  I $$VALI^XBDIQ1(9002011.13,R,.04)="" Q "0^0^No provider to check."
  1.  I $D(^AMHSITE(DUZ(2),19,"B",$$VALI^XBDIQ1(9002011.13,R,.04))) Q "0^1^Provider opted out of E Sig, no E Sig required."
  1.  I DUZ'=$$VALI^XBDIQ1(9002011.13,R,.04) Q "0^0^Only the provider is permitted to sign an Intake."
  1.  I '$O(^AMHRINTK(R,41,0)) Q "0^0^An Intake narrative must be entered before an E Sig can be applied^1"
  1.  Q "1^1"
  1.  ;
  1. ESIGGFII(AMHI) ;EP
  1.  W !!,"Intake Electronic Signature"
  1.  D SIG^XUSESIG
  1.  I X1="" Q
  1.  S DIE="^AMHRINTK(",DA=AMHI,DR=".11///NOW;.12///"_$P($G(^VA(200,DUZ,20)),U,2) D ^DIE K DA,DIE,DR
  1.  I $D(Y) W !!,"Error updating electronic signature...see your supervisor for programmer help."
  1.  K X1
  1.  Q
  1. ESIGREQI(R,D) ;EP - is esig required on this visit?
  1.  NEW SD,G
  1.  S R=$G(R)
  1.  S D=$G(D)
  1.  S SD=$$DATE()
  1.  I SD="" Q 0  ;no start date
  1.  ;
  1.  S G=0
  1.  I D]"" D  Q G
  1.  .I D<SD S G=0 Q
  1.  .S G=1
  1.  I R,$D(^AMHREC(R,0)) S D=$P($P(^AMHREC(R,0),U),".")
  1.  I D,D<SD Q 0
  1.  Q 1