AMHGP ; IHS/CMI/MAW - AMHG Patient Lookup 4/28/2009 12:43:21 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
;
;
;
Q
GETPAT(RETVAL,AMHSTR) ;EP -- return patient in ADO table
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHERRR,AMHUIEN,P
S P="|"
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
S AMHERRR=""
S ^AMHTMP($J,AMHI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030MORE^T00030DOD^T00010AGE^T00001MESSAGEFLAG^T02500MESSAGE"_$C(30)
S AMHDUZ2=$P(AMHSTR,P)
S AMHPAT=$P(AMHSTR,P,2)
S AMHMT=$P(AMHSTR,P,3)
S AMHNPAT=$P(AMHSTR,P,4)
I '$G(AMHDUZ2) S AMHDUZ2=DUZ(2)
;I AMHNPAT]"" S AMHPAT=AMHNPAT ;cmi/maw 3/12/09 for testing
I AMHMT="ALL" S AMHMT=9999999
S AMHMT=(AMHMT-1)
I AMHPAT?9N D
. S AMHPIEN=$$PATSSN(AMHPAT)
I AMHPAT?1.7N D ;ihs/cmi/maw 09/12/2012 AMH 4.0p4 allow for 7 digit chart numbers
. S AMHPIEN=$$PATCHT(.AMHPIEN,AMHPAT)
I AMHPAT?1.2N1"/"1.2N1"/"4N D
. S X=AMHPAT D ^%DT S AMHPAT=Y
. S AMHPIEN=$$PATDOB(.AMHPIEN,AMHPAT)
I '$G(AMHPIEN) D PATNAM(.AMHPIEN,AMHPAT,AMHNPAT)
I $G(AMHPIEN),'$G(AMHPATS) D PATADO(.AMHPIEN)
S ^AMHTMP($J,AMHI+1)=$C(31)
K AMHPAT,AMHPIEN,AMHCNT,AMHDA,AMHIEN,AMHPATE,AMHNM,AMHDB,AMHSX,AMHCT,AMHSSN,AMHDOD,AMHMORE,AMHAGE,AMHCNTR,AMHDG,AMHDUZ2,AMHMT,AMHNAM
K AMHPATS,AMHNPAT,AMHPI,AMHUPD
Q
;
PATSSN(PAT) ;EP -- look up by ssn
S AMHPIEN=$O(^DPT("SSN",PAT,0))
S AMHPIEN(1)=AMHPIEN
Q $G(AMHPIEN)
;
PATCHT(AMHPIEN,PAT) ;EP -- lookup by chart
;ihs/cmi/maw 2/2/2011 added fix for same patient with same chart in multiple divisions
N AMHCNT,AMHOEN
S AMHCNT=0,AMHPATE=0,AMHMCNT=0
S AMHDA=(PAT-1) F S AMHDA=$O(^AUPNPAT("D",AMHDA)) Q:'AMHDA!(AMHDA>PAT)!(AMHCNT>AMHMT) D
. S AMHIEN=0 F S AMHIEN=$O(^AUPNPAT("D",AMHDA,AMHIEN)) Q:'AMHIEN D
.. S AMHOEN=0 F S AMHOEN=$O(^AUPNPAT("D",AMHDA,AMHIEN,AMHOEN)) Q:'AMHOEN!($G(AMHPIEN)) D
... ;I $O(^AUPNPAT("D",AMHDA,AMHIEN,0))=AMHDUZ2 S AMHPIEN=AMHIEN
... I AMHOEN=AMHDUZ2 S AMHPIEN=AMHIEN
... Q:'$G(AMHPIEN)
... S AMHCNT=AMHCNT+1
... S:'$D(AMHPIEN(AMHCNT)) AMHPIEN(AMHCNT)=0
... S AMHPIEN(AMHCNT)=AMHPIEN
Q $G(AMHPIEN)
;
PATDOB(AMHPATE,PAT) ;EP -- lookup by DOB
N AMHCNT
S AMHCNT=0,AMHPATE=0
S AMHDOB=PAT-1 F S AMHDOB=$O(^DPT("ADOB",AMHDOB)) Q:'AMHDOB!(AMHDOB'=+PAT)!(AMHCNT>AMHMT) D
. S AMHIEN=0 F S AMHIEN=$O(^DPT("ADOB",AMHDOB,AMHIEN)) Q:'AMHIEN D
.. S:'$D(AMHPATE(AMHCNT)) AMHPATE(AMHCNT)=0
.. S AMHCNT=AMHCNT+1,AMHPATE=1
.. S AMHPATE(AMHCNT)=AMHIEN
S AMHPATE=AMHCNT
Q $G(AMHPATE)
;
PATNAM(AMHPATE,PAT,NPAT) ;lookup by name
S AMHCNT=0,AMHPATE=0
N AMHLEN
S AMHLEN=$L(PAT)
S AMHNAM=PAT
S AMHNAM=$$BEGIN(PAT)
I $G(NPAT)]"" S AMHNAM=NPAT
F S AMHNAM=$O(^DPT("B",AMHNAM)) Q:AMHNAM=""!($E(AMHNAM,1,AMHLEN)'=PAT) D
. S AMHIEN=0 F S AMHIEN=$O(^DPT("B",AMHNAM,AMHIEN)) Q:'AMHIEN D
.. N AMHOEN
.. I $O(^DPT("B",AMHNAM,AMHIEN,0)) D
... S AMHOEN=0 F S AMHOEN=$O(^DPT("B",AMHNAM,AMHIEN,AMHOEN)) Q:'AMHOEN D
.... ;Q:$O(^DPT("B",AMHNAM,AMHIEN,0)) ;cmi/maw 4/25/2005 don't get aliases
.... S AMHCNT=AMHCNT+1
.... S:'$D(AMHPATE(AMHCNT)) AMHPATE(AMHCNT)=0
.... S AMHPATE(AMHCNT)=AMHIEN_U_AMHNAM
.. I '$O(^DPT("B",AMHNAM,AMHIEN,0)) D
... S AMHCNT=AMHCNT+1
... S:'$D(AMHPATE(AMHCNT)) AMHPATE(AMHCNT)=0
... S AMHPATE(AMHCNT)=AMHIEN
S AMHPATE=AMHCNT
Q $G(AMHPATE)
;
BEGIN(PT) ;EP -- get begin point
N AMHPDA,AMHPIEN,AMHPCNT
S AMHPCNT=0
S AMHPDA=PT
I $O(^DPT("B",AMHPDA,0)) D
. S AMHPDA=$O(^DPT("B",AMHPDA),-1)
F S AMHPDA=$O(^DPT("B",AMHPDA)) Q
I $G(AMHPDA)="" Q ""
Q $O(^DPT("B",AMHPDA),-1)
;
PATADO(PIEN) ;EP -- ado return
S AMHCNTR=0
S AMHDA=0 F S AMHDA=$O(PIEN(AMHDA)) Q:'AMHDA D
. S AMHPI=$P($G(PIEN(AMHDA)),U)
. S AMHAL=$P($G(PIEN(AMHDA)),U,2)
. Q:'$$GUIPL^AMHUTIL(AMHPI,DUZ,AMHDUZ2) ;see if user is allowed to see patient
. ;D PTSEC^DGSEC4(.AMHDG,AMHPI,0) ;logs patient, cant do here
. D DGSEC(.AMHDG,AMHPI,DUZ,0) ;don't log patient but get sensitivity info for patient lookup
. N AMHDGMSG,AMHFLAG
. I $G(AMHDG(1)) D
.. S AMHFLAG=AMHDG(1)
.. N AMHDGDA
.. S AMHDGMSG=""
.. S AMHDGDA=1 F S AMHDGDA=$O(AMHDG(AMHDGDA)) Q:'AMHDGDA D
... I $E(AMHDG(AMHDGDA),1,3)="* *" Q
... S AMHDGMSG=AMHDGMSG_" "_$G(AMHDG(AMHDGDA))
. S AMHDGMSG=$TR($G(AMHDGMSG),"*")
. I AMHCNTR>AMHMT Q
. S AMHCNTR=AMHCNTR+1
. S AMHNM=$S(AMHAL]"":AMHAL_" ",1:"")_$P($G(^DPT(AMHPI,0)),U)
. ;S AMHDB=$$FMTE^XLFDT($P($G(^DPT(AMHPI,0)),U,3))
. S AMHDB=$$LVDT^AMHGU($P($G(^DPT(AMHPI,0)),U,3))
. I $G(AMHFLAG),$G(AMHFLAG)'=4,$G(AMHFLAG)'=3 S AMHDB="**SENSITIVE**"
. S AMHSX=$P($G(^DPT(AMHPI,0)),U,2)
. S AMHCT=$$HRN^AUPNPAT(AMHPI,AMHDUZ2)
. S AMHSSN=$P($G(^DPT(AMHPI,0)),U,9)
. I AMHSSN]"" D
.. N LN
.. S LN=$L(AMHSSN)
.. S AMHSSN="XXX-XX-"_$E(AMHSSN,(LN-3),LN)
. I $G(AMHFLAG),$G(AMHFLAG)'=4,$G(AMHFLAG)'=3 S AMHSSN="**SENSITIVE**"
. S AMHUPD=$P($G(^AUPNPAT(AMHPI,0)),U,3) ;cmi/maw 5/17/2007 added last reg update
. ;S AMHELG=$$GET1^DIQ(9000001,AMHPI,1111) ;cmi/maw 5/17/2007 added class/ben for status bar
. S AMHDOD=$S($P($G(^DPT(AMHPI,.35)),U):$$LVDT^AMHGU($P($G(^DPT(AMHPI,.35)),U)),1:"")
. S AMHAGE=$$AGE^AUPNPAT(AMHPI,DT)
. I $G(AMHFLAG) S AMHAGE="**SENSITIVE**"
. I '$G(AMHFLAG),$$GET1^DIQ(43,1,9999999.01)="YES" S AMHFLAG=9 ;ihs/cmi/maw 12/6/2010 for track all patients spt
. S AMHI=AMHI+1
. S ^AMHTMP($J,AMHI)=AMHPI_U_AMHNM_U_AMHDB_U_AMHSX_U_AMHCT_U_AMHSSN_U_$G(AMHHD)_U_$G(AMHMORE)_U_AMHDOD_U_AMHAGE_U_$G(AMHFLAG)_U_$E(AMHDGMSG,1,2500)_$C(30)
Q
;
PATSTR(RETVAL,AMHSTR) ;EP -- return the patient demographic information
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHERRR,AMHUIEN,P
S P="|"
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
S AMHERRR=""
S ^AMHTMP($J,AMHI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030MORE^T00030DOD^T00010AGE^T00001MESSAGEFLAG^T02500MESSAGE"_$C(30)
S AMHPAT(1)=$P(AMHSTR,P,2)
S AMHDUZ2=$P(AMHSTR,P)
S AMHMT=9999999
D PATADO(.AMHPAT)
S ^AMHTMP($J,AMHI+1)=$C(31)
Q
;
LOGPAT(RETVAL,AMHSTR) ;-- log sensitive patient information
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHERRR,AMHPAT,P,AMHFLAG,AMHDGMSG,AMHDGDA,RESULT
S P="|"
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
S AMHPAT=$P(AMHSTR,P)
D DGSEC(.RESULT,AMHPAT,DUZ,0) ;cmi/maw 3/4/2010 logging takes place in NOTICE^DGSEC4
I $G(RESULT(1))=4 S AMHFLAG=1
I $G(RESULT(1))=3 S AMHFLAG=1
I '$G(AMHFLAG),$G(RESULT(1))'=0 D NOTICE^DGSEC4(.RESULT,AMHPAT,"AMHGRPC^Behavioral Health GUI",3)
I $G(RESULT(1))=0,$$GET1^DIQ(43,1,9999999.01)="YES" D ;ihs/cmi/maw 12/6/2010 added for track all
. D NOTICE^DGSEC4(.RESULT,AMHPAT,"AMHGRPC^Behavioral Health GUI",$S($P($G(^DGSL(38.1,AMHPAT,0)),U,2):3,1:1))
S @RETVAL@(AMHI)="T00001Return"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$G(RESULT)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
DGSEC(RESULT,DFN,DUZ,DGMSG) ;EP -- mock the dgsec call but dont log, couldnt find a way to call PTSEC^DGSEC4 without logging
S DGMSG=$G(DGMSG,1)
I $$STATUS^BDGSPT2(DUZ,DFN,1)["RESTRICTED ACCESS" D Q
.S RESULT(1)=5 Q:DGMSG'=1
.S RESULT(2)="Sorry, you are restricted from accessing this patient's record."
.S RESULT(3)="If you have questions, please contact your HIM department."
D OWNREC^DGSEC4(.RESULT,DFN,$G(DUZ),DGMSG)
I RESULT(1)=1 S RESULT(1)=3 Q
I RESULT(1)=2 S RESULT(1)=4 Q
K RESULT
D SENS^DGSEC4(.RESULT,DFN,$G(DUZ))
Q
;
AMHGP ; IHS/CMI/MAW - AMHG Patient Lookup 4/28/2009 12:43:21 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
+2 ;
+3 ;
+4 ;
+5 QUIT
GETPAT(RETVAL,AMHSTR) ;EP -- return patient in ADO table
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHERRR,AMHUIEN,P
+3 SET P="|"
+4 KILL ^AMHTMP($JOB)
+5 SET RETVAL="^AMHTMP("_$JOB_")"
+6 SET AMHI=0
+7 SET AMHERRR=""
+8 SET ^AMHTMP($JOB,AMHI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030MORE^T00030DOD^T00010AGE^T00001MESSAGEFLAG^T02500MESSAGE"_$CHAR(30)
+9 SET AMHDUZ2=$PIECE(AMHSTR,P)
+10 SET AMHPAT=$PIECE(AMHSTR,P,2)
+11 SET AMHMT=$PIECE(AMHSTR,P,3)
+12 SET AMHNPAT=$PIECE(AMHSTR,P,4)
+13 IF '$GET(AMHDUZ2)
SET AMHDUZ2=DUZ(2)
+14 ;I AMHNPAT]"" S AMHPAT=AMHNPAT ;cmi/maw 3/12/09 for testing
+15 IF AMHMT="ALL"
SET AMHMT=9999999
+16 SET AMHMT=(AMHMT-1)
+17 IF AMHPAT?9N
Begin DoDot:1
+18 SET AMHPIEN=$$PATSSN(AMHPAT)
End DoDot:1
+19 ;ihs/cmi/maw 09/12/2012 AMH 4.0p4 allow for 7 digit chart numbers
IF AMHPAT?1.7N
Begin DoDot:1
+20 SET AMHPIEN=$$PATCHT(.AMHPIEN,AMHPAT)
End DoDot:1
+21 IF AMHPAT?1.2N1"/"1.2N1"/"4N
Begin DoDot:1
+22 SET X=AMHPAT
DO ^%DT
SET AMHPAT=Y
+23 SET AMHPIEN=$$PATDOB(.AMHPIEN,AMHPAT)
End DoDot:1
+24 IF '$GET(AMHPIEN)
DO PATNAM(.AMHPIEN,AMHPAT,AMHNPAT)
+25 IF $GET(AMHPIEN)
IF '$GET(AMHPATS)
DO PATADO(.AMHPIEN)
+26 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+27 KILL AMHPAT,AMHPIEN,AMHCNT,AMHDA,AMHIEN,AMHPATE,AMHNM,AMHDB,AMHSX,AMHCT,AMHSSN,AMHDOD,AMHMORE,AMHAGE,AMHCNTR,AMHDG,AMHDUZ2,AMHMT,AMHNAM
+28 KILL AMHPATS,AMHNPAT,AMHPI,AMHUPD
+29 QUIT
+30 ;
PATSSN(PAT) ;EP -- look up by ssn
+1 SET AMHPIEN=$ORDER(^DPT("SSN",PAT,0))
+2 SET AMHPIEN(1)=AMHPIEN
+3 QUIT $GET(AMHPIEN)
+4 ;
PATCHT(AMHPIEN,PAT) ;EP -- lookup by chart
+1 ;ihs/cmi/maw 2/2/2011 added fix for same patient with same chart in multiple divisions
+2 NEW AMHCNT,AMHOEN
+3 SET AMHCNT=0
SET AMHPATE=0
SET AMHMCNT=0
+4 SET AMHDA=(PAT-1)
FOR
SET AMHDA=$ORDER(^AUPNPAT("D",AMHDA))
IF 'AMHDA!(AMHDA>PAT)!(AMHCNT>AMHMT)
QUIT
Begin DoDot:1
+5 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AUPNPAT("D",AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+6 SET AMHOEN=0
FOR
SET AMHOEN=$ORDER(^AUPNPAT("D",AMHDA,AMHIEN,AMHOEN))
IF 'AMHOEN!($GET(AMHPIEN))
QUIT
Begin DoDot:3
+7 ;I $O(^AUPNPAT("D",AMHDA,AMHIEN,0))=AMHDUZ2 S AMHPIEN=AMHIEN
+8 IF AMHOEN=AMHDUZ2
SET AMHPIEN=AMHIEN
+9 IF '$GET(AMHPIEN)
QUIT
+10 SET AMHCNT=AMHCNT+1
+11 IF '$DATA(AMHPIEN(AMHCNT))
SET AMHPIEN(AMHCNT)=0
+12 SET AMHPIEN(AMHCNT)=AMHPIEN
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT $GET(AMHPIEN)
+14 ;
PATDOB(AMHPATE,PAT) ;EP -- lookup by DOB
+1 NEW AMHCNT
+2 SET AMHCNT=0
SET AMHPATE=0
+3 SET AMHDOB=PAT-1
FOR
SET AMHDOB=$ORDER(^DPT("ADOB",AMHDOB))
IF 'AMHDOB!(AMHDOB'=+PAT)!(AMHCNT>AMHMT)
QUIT
Begin DoDot:1
+4 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^DPT("ADOB",AMHDOB,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+5 IF '$DATA(AMHPATE(AMHCNT))
SET AMHPATE(AMHCNT)=0
+6 SET AMHCNT=AMHCNT+1
SET AMHPATE=1
+7 SET AMHPATE(AMHCNT)=AMHIEN
End DoDot:2
End DoDot:1
+8 SET AMHPATE=AMHCNT
+9 QUIT $GET(AMHPATE)
+10 ;
PATNAM(AMHPATE,PAT,NPAT) ;lookup by name
+1 SET AMHCNT=0
SET AMHPATE=0
+2 NEW AMHLEN
+3 SET AMHLEN=$LENGTH(PAT)
+4 SET AMHNAM=PAT
+5 SET AMHNAM=$$BEGIN(PAT)
+6 IF $GET(NPAT)]""
SET AMHNAM=NPAT
+7 FOR
SET AMHNAM=$ORDER(^DPT("B",AMHNAM))
IF AMHNAM=""!($EXTRACT(AMHNAM,1,AMHLEN)'=PAT)
QUIT
Begin DoDot:1
+8 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^DPT("B",AMHNAM,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+9 NEW AMHOEN
+10 IF $ORDER(^DPT("B",AMHNAM,AMHIEN,0))
Begin DoDot:3
+11 SET AMHOEN=0
FOR
SET AMHOEN=$ORDER(^DPT("B",AMHNAM,AMHIEN,AMHOEN))
IF 'AMHOEN
QUIT
Begin DoDot:4
+12 ;Q:$O(^DPT("B",AMHNAM,AMHIEN,0)) ;cmi/maw 4/25/2005 don't get aliases
+13 SET AMHCNT=AMHCNT+1
+14 IF '$DATA(AMHPATE(AMHCNT))
SET AMHPATE(AMHCNT)=0
+15 SET AMHPATE(AMHCNT)=AMHIEN_U_AMHNAM
End DoDot:4
End DoDot:3
+16 IF '$ORDER(^DPT("B",AMHNAM,AMHIEN,0))
Begin DoDot:3
+17 SET AMHCNT=AMHCNT+1
+18 IF '$DATA(AMHPATE(AMHCNT))
SET AMHPATE(AMHCNT)=0
+19 SET AMHPATE(AMHCNT)=AMHIEN
End DoDot:3
End DoDot:2
End DoDot:1
+20 SET AMHPATE=AMHCNT
+21 QUIT $GET(AMHPATE)
+22 ;
BEGIN(PT) ;EP -- get begin point
+1 NEW AMHPDA,AMHPIEN,AMHPCNT
+2 SET AMHPCNT=0
+3 SET AMHPDA=PT
+4 IF $ORDER(^DPT("B",AMHPDA,0))
Begin DoDot:1
+5 SET AMHPDA=$ORDER(^DPT("B",AMHPDA),-1)
End DoDot:1
+6 FOR
SET AMHPDA=$ORDER(^DPT("B",AMHPDA))
QUIT
+7 IF $GET(AMHPDA)=""
QUIT ""
+8 QUIT $ORDER(^DPT("B",AMHPDA),-1)
+9 ;
PATADO(PIEN) ;EP -- ado return
+1 SET AMHCNTR=0
+2 SET AMHDA=0
FOR
SET AMHDA=$ORDER(PIEN(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+3 SET AMHPI=$PIECE($GET(PIEN(AMHDA)),U)
+4 SET AMHAL=$PIECE($GET(PIEN(AMHDA)),U,2)
+5 ;see if user is allowed to see patient
IF '$$GUIPL^AMHUTIL(AMHPI,DUZ,AMHDUZ2)
QUIT
+6 ;D PTSEC^DGSEC4(.AMHDG,AMHPI,0) ;logs patient, cant do here
+7 ;don't log patient but get sensitivity info for patient lookup
DO DGSEC(.AMHDG,AMHPI,DUZ,0)
+8 NEW AMHDGMSG,AMHFLAG
+9 IF $GET(AMHDG(1))
Begin DoDot:2
+10 SET AMHFLAG=AMHDG(1)
+11 NEW AMHDGDA
+12 SET AMHDGMSG=""
+13 SET AMHDGDA=1
FOR
SET AMHDGDA=$ORDER(AMHDG(AMHDGDA))
IF 'AMHDGDA
QUIT
Begin DoDot:3
+14 IF $EXTRACT(AMHDG(AMHDGDA),1,3)="* *"
QUIT
+15 SET AMHDGMSG=AMHDGMSG_" "_$GET(AMHDG(AMHDGDA))
End DoDot:3
End DoDot:2
+16 SET AMHDGMSG=$TRANSLATE($GET(AMHDGMSG),"*")
+17 IF AMHCNTR>AMHMT
QUIT
+18 SET AMHCNTR=AMHCNTR+1
+19 SET AMHNM=$SELECT(AMHAL]"":AMHAL_" ",1:"")_$PIECE($GET(^DPT(AMHPI,0)),U)
+20 ;S AMHDB=$$FMTE^XLFDT($P($G(^DPT(AMHPI,0)),U,3))
+21 SET AMHDB=$$LVDT^AMHGU($PIECE($GET(^DPT(AMHPI,0)),U,3))
+22 IF $GET(AMHFLAG)
IF $GET(AMHFLAG)'=4
IF $GET(AMHFLAG)'=3
SET AMHDB="**SENSITIVE**"
+23 SET AMHSX=$PIECE($GET(^DPT(AMHPI,0)),U,2)
+24 SET AMHCT=$$HRN^AUPNPAT(AMHPI,AMHDUZ2)
+25 SET AMHSSN=$PIECE($GET(^DPT(AMHPI,0)),U,9)
+26 IF AMHSSN]""
Begin DoDot:2
+27 NEW LN
+28 SET LN=$LENGTH(AMHSSN)
+29 SET AMHSSN="XXX-XX-"_$EXTRACT(AMHSSN,(LN-3),LN)
End DoDot:2
+30 IF $GET(AMHFLAG)
IF $GET(AMHFLAG)'=4
IF $GET(AMHFLAG)'=3
SET AMHSSN="**SENSITIVE**"
+31 ;cmi/maw 5/17/2007 added last reg update
SET AMHUPD=$PIECE($GET(^AUPNPAT(AMHPI,0)),U,3)
+32 ;S AMHELG=$$GET1^DIQ(9000001,AMHPI,1111) ;cmi/maw 5/17/2007 added class/ben for status bar
+33 SET AMHDOD=$SELECT($PIECE($GET(^DPT(AMHPI,.35)),U):$$LVDT^AMHGU($PIECE($GET(^DPT(AMHPI,.35)),U)),1:"")
+34 SET AMHAGE=$$AGE^AUPNPAT(AMHPI,DT)
+35 IF $GET(AMHFLAG)
SET AMHAGE="**SENSITIVE**"
+36 ;ihs/cmi/maw 12/6/2010 for track all patients spt
IF '$GET(AMHFLAG)
IF $$GET1^DIQ(43,1,9999999.01)="YES"
SET AMHFLAG=9
+37 SET AMHI=AMHI+1
+38 SET ^AMHTMP($JOB,AMHI)=AMHPI_U_AMHNM_U_AMHDB_U_AMHSX_U_AMHCT_U_AMHSSN_U_$GET(AMHHD)_U_$GET(AMHMORE)_U_AMHDOD_U_AMHAGE_U_$GET(AMHFLAG)_U_$EXTRACT(AMHDGMSG,1,2500)_$CHAR(30)
End DoDot:1
+39 QUIT
+40 ;
PATSTR(RETVAL,AMHSTR) ;EP -- return the patient demographic information
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHERRR,AMHUIEN,P
+3 SET P="|"
+4 KILL ^AMHTMP($JOB)
+5 SET RETVAL="^AMHTMP("_$JOB_")"
+6 SET AMHI=0
+7 SET AMHERRR=""
+8 SET ^AMHTMP($JOB,AMHI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030MORE^T00030DOD^T00010AGE^T00001MESSAGEFLAG^T02500MESSAGE"_$CHAR(30)
+9 SET AMHPAT(1)=$PIECE(AMHSTR,P,2)
+10 SET AMHDUZ2=$PIECE(AMHSTR,P)
+11 SET AMHMT=9999999
+12 DO PATADO(.AMHPAT)
+13 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
LOGPAT(RETVAL,AMHSTR) ;-- log sensitive patient information
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHERRR,AMHPAT,P,AMHFLAG,AMHDGMSG,AMHDGDA,RESULT
+3 SET P="|"
+4 KILL ^AMHTMP($JOB)
+5 SET RETVAL="^AMHTMP("_$JOB_")"
+6 SET AMHI=0
+7 SET AMHPAT=$PIECE(AMHSTR,P)
+8 ;cmi/maw 3/4/2010 logging takes place in NOTICE^DGSEC4
DO DGSEC(.RESULT,AMHPAT,DUZ,0)
+9 IF $GET(RESULT(1))=4
SET AMHFLAG=1
+10 IF $GET(RESULT(1))=3
SET AMHFLAG=1
+11 IF '$GET(AMHFLAG)
IF $GET(RESULT(1))'=0
DO NOTICE^DGSEC4(.RESULT,AMHPAT,"AMHGRPC^Behavioral Health GUI",3)
+12 ;ihs/cmi/maw 12/6/2010 added for track all
IF $GET(RESULT(1))=0
IF $$GET1^DIQ(43,1,9999999.01)="YES"
Begin DoDot:1
+13 DO NOTICE^DGSEC4(.RESULT,AMHPAT,"AMHGRPC^Behavioral Health GUI",$SELECT($PIECE($GET(^DGSL(38.1,AMHPAT,0)),U,2):3,1:1))
End DoDot:1
+14 SET @RETVAL@(AMHI)="T00001Return"_$CHAR(30)
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=$GET(RESULT)_$CHAR(30)
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
DGSEC(RESULT,DFN,DUZ,DGMSG) ;EP -- mock the dgsec call but dont log, couldnt find a way to call PTSEC^DGSEC4 without logging
+1 SET DGMSG=$GET(DGMSG,1)
+2 IF $$STATUS^BDGSPT2(DUZ,DFN,1)["RESTRICTED ACCESS"
Begin DoDot:1
+3 SET RESULT(1)=5
IF DGMSG'=1
QUIT
+4 SET RESULT(2)="Sorry, you are restricted from accessing this patient's record."
+5 SET RESULT(3)="If you have questions, please contact your HIM department."
End DoDot:1
QUIT
+6 DO OWNREC^DGSEC4(.RESULT,DFN,$GET(DUZ),DGMSG)
+7 IF RESULT(1)=1
SET RESULT(1)=3
QUIT
+8 IF RESULT(1)=2
SET RESULT(1)=4
QUIT
+9 KILL RESULT
+10 DO SENS^DGSEC4(.RESULT,DFN,$GET(DUZ))
+11 QUIT
+12 ;
