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

AMHGESIG.m

Go to the documentation of this file.
  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
  1. ;
  1. ;
  1. ;
  1. ;
  1. DEBUG(RETVAL,AMHSTR) ;replace tag below to allow Serenji debug of GUI
  1. D DEBUG^%Serenji("GETPAT^AMHGU(.RETVAL,.AMHSTR)")
  1. Q
  1. ;
  1. CHKESIG(RETVAL,AMHSTR) ;-- check esig status
  1. S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1. N P,AMHREC,AMHGRP,AMHVAL
  1. S P="|"
  1. S AMHI=0
  1. K ^AMHTMP($J)
  1. S RETVAL="^AMHTMP("_$J_")"
  1. S ^AMHTMP($J,AMHI)="T00250Value"_$C(30)
  1. S AMHREC=$P(AMHSTR,P)
  1. S AMHGRP=+$P(AMHSTR,P,2)
  1. S AMHVAL=$$ESIG^AMHESIG(AMHREC,AMHGRP)
  1. S AMHI=AMHI+1
  1. S @RETVAL@(AMHI)=$TR(AMHVAL,U,"~")_$C(30)
  1. S @RETVAL@(AMHI+1)=$C(31)
  1. Q
  1. ;
  1. CHKIESIG(RETVAL,AMHSTR) ;-- check esig status
  1. S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1. N P,AMHREC,AMHGRP,AMHVAL
  1. S P="|"
  1. S AMHI=0
  1. K ^AMHTMP($J)
  1. S RETVAL="^AMHTMP("_$J_")"
  1. S ^AMHTMP($J,AMHI)="T00250Value"_$C(30)
  1. S AMHREC=$P(AMHSTR,P)
  1. S AMHGRP=+$P(AMHSTR,P,2)
  1. S AMHVAL=$$ESIGINT^AMHESIG(AMHREC,AMHGRP)
  1. S AMHI=AMHI+1
  1. S @RETVAL@(AMHI)=$TR(AMHVAL,U,"~")_$C(30)
  1. S @RETVAL@(AMHI+1)=$C(31)
  1. Q
  1. ;
  1. CHKGESIG(RETVAL,AMHSTR) ;-- check esig status
  1. S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1. N P,AMHREC,AMHGRP,AMHVAL
  1. S P="|"
  1. S AMHI=0
  1. K ^AMHTMP($J)
  1. S RETVAL="^AMHTMP("_$J_")"
  1. S ^AMHTMP($J,AMHI)="T00250Value"_$C(30)
  1. S AMHREC=$P(AMHSTR,P)
  1. S AMHGRP=+$P(AMHSTR,P,2)
  1. S AMHVAL=$$GESIG(AMHREC,AMHGRP)
  1. S AMHI=AMHI+1
  1. S @RETVAL@(AMHI)=$TR(AMHVAL,U,"~")_$C(30)
  1. S @RETVAL@(AMHI+1)=$C(31)
  1. Q
  1. ;
  1. SIGN(RETVAL,AMHSTR) ;-- sign the record if valid, if not return invalid
  1. S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1. N P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
  1. S P="|"
  1. S AMHI=0
  1. K ^AMHTMP($J)
  1. S RETVAL="^AMHTMP("_$J_")"
  1. S AMHREC=$P(AMHSTR,P)
  1. S AMHESIG=$P(AMHSTR,P,2)
  1. S X=AMHESIG
  1. D HASH^XUSHSHP
  1. S AMHEESIG=X
  1. S AMHPESIG=$P($G(^VA(200,DUZ,20)),U,4)
  1. S AMHVAL=$S(AMHEESIG=AMHPESIG:1,1:0)
  1. I $G(AMHVAL) D UPDREC(AMHREC,DUZ)
  1. S @RETVAL@(AMHI)="T00001Valid"_$C(30)
  1. S AMHI=AMHI+1
  1. S @RETVAL@(AMHI)=$G(AMHVAL)_$C(30)
  1. S @RETVAL@(AMHI+1)=$C(31)
  1. Q
  1. ;
  1. GSIGN(RETVAL,AMHSTR) ;-- sign the group record if valid, if not return invalid
  1. S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1. N P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
  1. S P="|"
  1. S AMHI=0
  1. K ^AMHTMP($J)
  1. S RETVAL="^AMHTMP("_$J_")"
  1. S AMHREC=$P(AMHSTR,P)
  1. S AMHESIG=$P(AMHSTR,P,2)
  1. S X=AMHESIG
  1. D HASH^XUSHSHP
  1. S AMHEESIG=X
  1. S AMHPESIG=$P($G(^VA(200,DUZ,20)),U,4)
  1. S AMHVAL=$S(AMHEESIG=AMHPESIG:1,1:0)
  1. I $G(AMHVAL) D UPDGREC(AMHREC,DUZ)
  1. S @RETVAL@(AMHI)="T00001Valid"_$C(30)
  1. S AMHI=AMHI+1
  1. S @RETVAL@(AMHI)=$G(AMHVAL)_$C(30)
  1. S @RETVAL@(AMHI+1)=$C(31)
  1. Q
  1. ;
  1. ISIGN(RETVAL,AMHSTR) ;-- sign the record if valid, if not return invalid
  1. S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1. N P,AMHREC,AMHESIG,AMHEESIG,AMHPESIG,AMHVAL
  1. S P="|"
  1. S AMHI=0
  1. K ^AMHTMP($J)
  1. S RETVAL="^AMHTMP("_$J_")"
  1. S AMHREC=$P(AMHSTR,P)
  1. S AMHESIG=$P(AMHSTR,P,2)
  1. S X=AMHESIG
  1. D HASH^XUSHSHP
  1. S AMHEESIG=X
  1. S AMHPESIG=$P($G(^VA(200,DUZ,20)),U,4)
  1. S AMHVAL=$S(AMHEESIG=AMHPESIG:1,1:0)
  1. I $G(AMHVAL) D UPDRECI(AMHREC,DUZ)
  1. S @RETVAL@(AMHI)="T00001Valid"_$C(30)
  1. S AMHI=AMHI+1
  1. S @RETVAL@(AMHI)=$G(AMHVAL)_$C(30)
  1. S @RETVAL@(AMHI+1)=$C(31)
  1. Q
  1. ;
  1. 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?
  1. I $$GET1^DIQ(9002011,REC,1112)]"",$$GET1^DIQ(9002011,REC,1113)]"" Q ;cmi/maw v4.0p10 dont update if an edit and signed
  1. N AMHFDA,AMHIENS,AMHERRR,AMHNOW
  1. S AMHIENS=REC_","
  1. S AMHNOW=$$NOW^XLFDT()
  1. S AMHFDA(9002011,AMHIENS,1112)=AMHNOW
  1. S AMHFDA(9002011,AMHIENS,1113)=$P($G(^VA(200,DUZ,20)),U,2)
  1. S AMHFDA(9002011,AMHIENS,1116)=$P($G(^VA(200,DUZ,20)),U,3)
  1. D FILE^DIE("K","AMHFDA","AMHERRR(1)")
  1. Q
  1. ;
  1. UPDRECI(REC,DZ) ;EP -- update the record with the date and user
  1. N AMHFDA,AMHIENS,AMHERRR,AMHNOW
  1. S AMHIENS=REC_","
  1. S AMHNOW=$$NOW^XLFDT()
  1. S AMHFDA(9002011.13,AMHIENS,.11)=AMHNOW
  1. S AMHFDA(9002011.13,AMHIENS,.12)=$P($G(^VA(200,DUZ,20)),U,2)
  1. D FILE^DIE("K","AMHFDA","AMHERRR(1)")
  1. Q
  1. ;
  1. UPDGREC(REC,DZ) ;-- update the record with the date and user
  1. N AMHFDA,AMHIENS,AMHERRR,AMHNOW
  1. S AMHIENS=REC_","
  1. S AMHNOW=$$NOW^XLFDT()
  1. S AMHFDA(9002011.67,AMHIENS,.18)=1
  1. S AMHFDA(9002011.67,AMHIENS,.21)=AMHNOW
  1. S AMHFDA(9002011.67,AMHIENS,.19)=$P($G(^VA(200,DUZ,20)),U,2)
  1. D FILE^DIE("K","AMHFDA","AMHERRR(1)")
  1. Q
  1. ;
  1. GESIG(R,G) ;EP - called for esig
  1. NEW X1,DA,DR,DIE,D
  1. S D=$P($P(^AMHGROUP(R,0),U),".")
  1. 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
  1. I $P($G(^AMHGROUP(R,0)),U,18)]"" Q "0^1^Note already signed, no E Sig necessary." ;
  1. I $$PP^AMHEGR(R)="" Q "0^0^No primary provider to check. No PCC link."
  1. I $D(^AMHSITE(DUZ(2),19,"B",$$PP^AMHEGR(R))) Q "0^1^Provider opted out of E Sig, no E Sig required."
  1. I DUZ'=$$PP^AMHEGR(R) Q "0^0^Only the Primary provider is permitted to sign a note."
  1. ;I '$O(^AMHGROUP(R,61,0)) Q "0^0^There were no visits created for this group."
  1. Q "1^1"
  1. ;