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

AGGPTSEN.m

Go to the documentation of this file.
  1. AGGPTSEN ;VNGT/HS/ALA-Sensitive Patient Options ; 20 Apr 2010 1:21 PM
  1. ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1. ;;
  1. ;
  1. Q
  1. ;
  1. CHK(DATA,DFN) ; EP -- AGG CHECK SENSITIVE PATIENT
  1. ;Description
  1. ; Checks whether a patient with a sensitive flag is accessible by
  1. ; this user or not
  1. ;
  1. ;Input
  1. ; DFN = Patient IEN
  1. ; Assumes DUZ
  1. ;Output
  1. ; 0 = is not really sensitive
  1. ; 1 = is sensitive but DUZ has key that allows access
  1. ; 2 = is sensitive but DUZ does not have key that allows access
  1. ; so if user continues on, a record must be logged
  1. ;
  1. NEW UID,II,TEXT,X
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("AGGPTSEN",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTSEN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S @DATA@(II)="T00001SENSITIVE_INDICATOR"_$C(30)
  1. D SENS^DGSEC4(.TEXT,DFN,DUZ)
  1. S II=II+1,@DATA@(II)=$G(TEXT(1))_$C(30)
  1. S II=II+1,@DATA@(II)=$C(31)
  1. Q
  1. ;
  1. ERR ;
  1. D ^%ZTER
  1. NEW Y,ERRDTM
  1. S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1. S BMXSEC="Recording that an error occurred at "_ERRDTM
  1. I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1. Q
  1. ;
  1. NOT(DATA,DFN) ; EP -- AGG SEND SENSITIVE NOTIFY
  1. ;Description
  1. ; Send sensitive patient notification
  1. ;Input
  1. ; DFN - Patient IEN
  1. ; Assumes DUZ
  1. ;
  1. NEW UID,II,RESULT
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("AGGPTSEN",UID))
  1. K @DATA
  1. ;
  1. S II=0
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTSEN D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S @DATA@(II)="I00010RESULT"_$C(30)
  1. D NOTICE^DGSEC4(.RESULT,DFN,"AGGRPC^AGG RPC Calls")
  1. S II=II+1,@DATA@(II)=RESULT_$C(30)
  1. S II=II+1,@DATA@(II)=$C(31)
  1. Q