AMHGESIG ; IHS/CMI/MAW - AMHG GUI ESig Utilities 6/22/2009 11:14:59 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,10**;JUN 02, 2010;Build 15
;
;
;
;
DEBUG(RETVAL,AMHSTR) ;replace tag below to allow Serenji debug of GUI
D DEBUG^%Serenji("GETPAT^AMHGU(.RETVAL,.AMHSTR)")
Q
;
CHKESIG(RETVAL,AMHSTR) ;-- check esig status
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N P,AMHREC,AMHGRP,AMHVAL
S P="|"
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S ^AMHTMP($J,AMHI)="T00250Value"_$C(30)
S AMHREC=$P(AMHSTR,P)
S AMHGRP=+$P(AMHSTR,P,2)
S AMHVAL=$$ESIG^AMHESIG(AMHREC,AMHGRP)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$TR(AMHVAL,U,"~")_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
CHKIESIG(RETVAL,AMHSTR) ;-- check esig status
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N P,AMHREC,AMHGRP,AMHVAL
S P="|"
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S ^AMHTMP($J,AMHI)="T00250Value"_$C(30)
S AMHREC=$P(AMHSTR,P)
S AMHGRP=+$P(AMHSTR,P,2)
S AMHVAL=$$ESIGINT^AMHESIG(AMHREC,AMHGRP)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$TR(AMHVAL,U,"~")_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
CHKGESIG(RETVAL,AMHSTR) ;-- check esig status
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N P,AMHREC,AMHGRP,AMHVAL
S P="|"
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S ^AMHTMP($J,AMHI)="T00250Value"_$C(30)
S AMHREC=$P(AMHSTR,P)
S AMHGRP=+$P(AMHSTR,P,2)
S AMHVAL=$$GESIG(AMHREC,AMHGRP)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$TR(AMHVAL,U,"~")_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SIGN(RETVAL,AMHSTR) ;-- sign the record if valid, if not return invalid
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
S P="|"
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S AMHREC=$P(AMHSTR,P)
S AMHESIG=$P(AMHSTR,P,2)
S X=AMHESIG
D HASH^XUSHSHP
S AMHEESIG=X
S AMHPESIG=$P($G(^VA(200,DUZ,20)),U,4)
S AMHVAL=$S(AMHEESIG=AMHPESIG:1,1:0)
I $G(AMHVAL) D UPDREC(AMHREC,DUZ)
S @RETVAL@(AMHI)="T00001Valid"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$G(AMHVAL)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
GSIGN(RETVAL,AMHSTR) ;-- sign the group record if valid, if not return invalid
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
S P="|"
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S AMHREC=$P(AMHSTR,P)
S AMHESIG=$P(AMHSTR,P,2)
S X=AMHESIG
D HASH^XUSHSHP
S AMHEESIG=X
S AMHPESIG=$P($G(^VA(200,DUZ,20)),U,4)
S AMHVAL=$S(AMHEESIG=AMHPESIG:1,1:0)
I $G(AMHVAL) D UPDGREC(AMHREC,DUZ)
S @RETVAL@(AMHI)="T00001Valid"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$G(AMHVAL)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
ISIGN(RETVAL,AMHSTR) ;-- sign the record if valid, if not return invalid
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
S P="|"
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S AMHREC=$P(AMHSTR,P)
S AMHESIG=$P(AMHSTR,P,2)
S X=AMHESIG
D HASH^XUSHSHP
S AMHEESIG=X
S AMHPESIG=$P($G(^VA(200,DUZ,20)),U,4)
S AMHVAL=$S(AMHEESIG=AMHPESIG:1,1:0)
I $G(AMHVAL) D UPDRECI(AMHREC,DUZ)
S @RETVAL@(AMHI)="T00001Valid"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$G(AMHVAL)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
UPDREC(REC,DZ) ;EP -- update the record with the date and user
;cmi/maw v4.0p10 also do we need to check for groups only?
I $$GET1^DIQ(9002011,REC,1112)]"",$$GET1^DIQ(9002011,REC,1113)]"" Q ;cmi/maw v4.0p10 dont update if an edit and signed
N AMHFDA,AMHIENS,AMHERRR,AMHNOW
S AMHIENS=REC_","
S AMHNOW=$$NOW^XLFDT()
S AMHFDA(9002011,AMHIENS,1112)=AMHNOW
S AMHFDA(9002011,AMHIENS,1113)=$P($G(^VA(200,DUZ,20)),U,2)
S AMHFDA(9002011,AMHIENS,1116)=$P($G(^VA(200,DUZ,20)),U,3)
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
Q
;
UPDRECI(REC,DZ) ;EP -- update the record with the date and user
N AMHFDA,AMHIENS,AMHERRR,AMHNOW
S AMHIENS=REC_","
S AMHNOW=$$NOW^XLFDT()
S AMHFDA(9002011.13,AMHIENS,.11)=AMHNOW
S AMHFDA(9002011.13,AMHIENS,.12)=$P($G(^VA(200,DUZ,20)),U,2)
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
Q
;
UPDGREC(REC,DZ) ;-- update the record with the date and user
N AMHFDA,AMHIENS,AMHERRR,AMHNOW
S AMHIENS=REC_","
S AMHNOW=$$NOW^XLFDT()
S AMHFDA(9002011.67,AMHIENS,.18)=1
S AMHFDA(9002011.67,AMHIENS,.21)=AMHNOW
S AMHFDA(9002011.67,AMHIENS,.19)=$P($G(^VA(200,DUZ,20)),U,2)
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
Q
;
GESIG(R,G) ;EP - called for esig
NEW X1,DA,DR,DIE,D
S D=$P($P(^AMHGROUP(R,0),U),".")
I '$$ESIGREQ^AMHESIG(,D) Q "0^1^E Sig not required for this group, visit is prior to Version 4.0 install date." ;not required
I $P($G(^AMHGROUP(R,0)),U,18)]"" Q "0^1^Note already signed, no E Sig necessary." ;
I $$PP^AMHEGR(R)="" Q "0^0^No primary provider to check. No PCC link."
I $D(^AMHSITE(DUZ(2),19,"B",$$PP^AMHEGR(R))) Q "0^1^Provider opted out of E Sig, no E Sig required."
I DUZ'=$$PP^AMHEGR(R) Q "0^0^Only the Primary provider is permitted to sign a note."
;I '$O(^AMHGROUP(R,61,0)) Q "0^0^There were no visits created for this group."
Q "1^1"
;
AMHGESIG ; IHS/CMI/MAW - AMHG GUI ESig Utilities 6/22/2009 11:14:59 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,10**;JUN 02, 2010;Build 15
+2 ;
+3 ;
+4 ;
+5 ;
DEBUG(RETVAL,AMHSTR) ;replace tag below to allow Serenji debug of GUI
+1 DO DEBUG^%Serenji("GETPAT^AMHGU(.RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
CHKESIG(RETVAL,AMHSTR) ;-- check esig status
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW P,AMHREC,AMHGRP,AMHVAL
+3 SET P="|"
+4 SET AMHI=0
+5 KILL ^AMHTMP($JOB)
+6 SET RETVAL="^AMHTMP("_$JOB_")"
+7 SET ^AMHTMP($JOB,AMHI)="T00250Value"_$CHAR(30)
+8 SET AMHREC=$PIECE(AMHSTR,P)
+9 SET AMHGRP=+$PIECE(AMHSTR,P,2)
+10 SET AMHVAL=$$ESIG^AMHESIG(AMHREC,AMHGRP)
+11 SET AMHI=AMHI+1
+12 SET @RETVAL@(AMHI)=$TRANSLATE(AMHVAL,U,"~")_$CHAR(30)
+13 SET @RETVAL@(AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
CHKIESIG(RETVAL,AMHSTR) ;-- check esig status
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW P,AMHREC,AMHGRP,AMHVAL
+3 SET P="|"
+4 SET AMHI=0
+5 KILL ^AMHTMP($JOB)
+6 SET RETVAL="^AMHTMP("_$JOB_")"
+7 SET ^AMHTMP($JOB,AMHI)="T00250Value"_$CHAR(30)
+8 SET AMHREC=$PIECE(AMHSTR,P)
+9 SET AMHGRP=+$PIECE(AMHSTR,P,2)
+10 SET AMHVAL=$$ESIGINT^AMHESIG(AMHREC,AMHGRP)
+11 SET AMHI=AMHI+1
+12 SET @RETVAL@(AMHI)=$TRANSLATE(AMHVAL,U,"~")_$CHAR(30)
+13 SET @RETVAL@(AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
CHKGESIG(RETVAL,AMHSTR) ;-- check esig status
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW P,AMHREC,AMHGRP,AMHVAL
+3 SET P="|"
+4 SET AMHI=0
+5 KILL ^AMHTMP($JOB)
+6 SET RETVAL="^AMHTMP("_$JOB_")"
+7 SET ^AMHTMP($JOB,AMHI)="T00250Value"_$CHAR(30)
+8 SET AMHREC=$PIECE(AMHSTR,P)
+9 SET AMHGRP=+$PIECE(AMHSTR,P,2)
+10 SET AMHVAL=$$GESIG(AMHREC,AMHGRP)
+11 SET AMHI=AMHI+1
+12 SET @RETVAL@(AMHI)=$TRANSLATE(AMHVAL,U,"~")_$CHAR(30)
+13 SET @RETVAL@(AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
SIGN(RETVAL,AMHSTR) ;-- sign the record if valid, if not return invalid
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
+3 SET P="|"
+4 SET AMHI=0
+5 KILL ^AMHTMP($JOB)
+6 SET RETVAL="^AMHTMP("_$JOB_")"
+7 SET AMHREC=$PIECE(AMHSTR,P)
+8 SET AMHESIG=$PIECE(AMHSTR,P,2)
+9 SET X=AMHESIG
+10 DO HASH^XUSHSHP
+11 SET AMHEESIG=X
+12 SET AMHPESIG=$PIECE($GET(^VA(200,DUZ,20)),U,4)
+13 SET AMHVAL=$SELECT(AMHEESIG=AMHPESIG:1,1:0)
+14 IF $GET(AMHVAL)
DO UPDREC(AMHREC,DUZ)
+15 SET @RETVAL@(AMHI)="T00001Valid"_$CHAR(30)
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=$GET(AMHVAL)_$CHAR(30)
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
GSIGN(RETVAL,AMHSTR) ;-- sign the group record if valid, if not return invalid
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
+3 SET P="|"
+4 SET AMHI=0
+5 KILL ^AMHTMP($JOB)
+6 SET RETVAL="^AMHTMP("_$JOB_")"
+7 SET AMHREC=$PIECE(AMHSTR,P)
+8 SET AMHESIG=$PIECE(AMHSTR,P,2)
+9 SET X=AMHESIG
+10 DO HASH^XUSHSHP
+11 SET AMHEESIG=X
+12 SET AMHPESIG=$PIECE($GET(^VA(200,DUZ,20)),U,4)
+13 SET AMHVAL=$SELECT(AMHEESIG=AMHPESIG:1,1:0)
+14 IF $GET(AMHVAL)
DO UPDGREC(AMHREC,DUZ)
+15 SET @RETVAL@(AMHI)="T00001Valid"_$CHAR(30)
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=$GET(AMHVAL)_$CHAR(30)
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
ISIGN(RETVAL,AMHSTR) ;-- sign the record if valid, if not return invalid
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
+3 SET P="|"
+4 SET AMHI=0
+5 KILL ^AMHTMP($JOB)
+6 SET RETVAL="^AMHTMP("_$JOB_")"
+7 SET AMHREC=$PIECE(AMHSTR,P)
+8 SET AMHESIG=$PIECE(AMHSTR,P,2)
+9 SET X=AMHESIG
+10 DO HASH^XUSHSHP
+11 SET AMHEESIG=X
+12 SET AMHPESIG=$PIECE($GET(^VA(200,DUZ,20)),U,4)
+13 SET AMHVAL=$SELECT(AMHEESIG=AMHPESIG:1,1:0)
+14 IF $GET(AMHVAL)
DO UPDRECI(AMHREC,DUZ)
+15 SET @RETVAL@(AMHI)="T00001Valid"_$CHAR(30)
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=$GET(AMHVAL)_$CHAR(30)
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
UPDREC(REC,DZ) ;EP -- update the record with the date and user
+1 ;cmi/maw v4.0p10 also do we need to check for groups only?
+2 ;cmi/maw v4.0p10 dont update if an edit and signed
IF $$GET1^DIQ(9002011,REC,1112)]""
IF $$GET1^DIQ(9002011,REC,1113)]""
QUIT
+3 NEW AMHFDA,AMHIENS,AMHERRR,AMHNOW
+4 SET AMHIENS=REC_","
+5 SET AMHNOW=$$NOW^XLFDT()
+6 SET AMHFDA(9002011,AMHIENS,1112)=AMHNOW
+7 SET AMHFDA(9002011,AMHIENS,1113)=$PIECE($GET(^VA(200,DUZ,20)),U,2)
+8 SET AMHFDA(9002011,AMHIENS,1116)=$PIECE($GET(^VA(200,DUZ,20)),U,3)
+9 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+10 QUIT
+11 ;
UPDRECI(REC,DZ) ;EP -- update the record with the date and user
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHNOW
+2 SET AMHIENS=REC_","
+3 SET AMHNOW=$$NOW^XLFDT()
+4 SET AMHFDA(9002011.13,AMHIENS,.11)=AMHNOW
+5 SET AMHFDA(9002011.13,AMHIENS,.12)=$PIECE($GET(^VA(200,DUZ,20)),U,2)
+6 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+7 QUIT
+8 ;
UPDGREC(REC,DZ) ;-- update the record with the date and user
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHNOW
+2 SET AMHIENS=REC_","
+3 SET AMHNOW=$$NOW^XLFDT()
+4 SET AMHFDA(9002011.67,AMHIENS,.18)=1
+5 SET AMHFDA(9002011.67,AMHIENS,.21)=AMHNOW
+6 SET AMHFDA(9002011.67,AMHIENS,.19)=$PIECE($GET(^VA(200,DUZ,20)),U,2)
+7 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+8 QUIT
+9 ;
GESIG(R,G) ;EP - called for esig
+1 NEW X1,DA,DR,DIE,D
+2 SET D=$PIECE($PIECE(^AMHGROUP(R,0),U),".")
+3 ;not required
IF '$$ESIGREQ^AMHESIG(,D)
QUIT "0^1^E Sig not required for this group, visit is prior to Version 4.0 install date."
+4 ;
IF $PIECE($GET(^AMHGROUP(R,0)),U,18)]""
QUIT "0^1^Note already signed, no E Sig necessary."
+5 IF $$PP^AMHEGR(R)=""
QUIT "0^0^No primary provider to check. No PCC link."
+6 IF $DATA(^AMHSITE(DUZ(2),19,"B",$$PP^AMHEGR(R)))
QUIT "0^1^Provider opted out of E Sig, no E Sig required."
+7 IF DUZ'=$$PP^AMHEGR(R)
QUIT "0^0^Only the Primary provider is permitted to sign a note."
+8 ;I '$O(^AMHGROUP(R,61,0)) Q "0^0^There were no visits created for this group."
+9 QUIT "1^1"
+10 ;
