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