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

AMHGP.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;
  1.  Q
  1. GETPAT(RETVAL,AMHSTR) ;EP -- return patient in ADO table
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHERRR,AMHUIEN,P
  1.  S P="|"
  1.  K ^AMHTMP($J)
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  S AMHERRR=""
  1.  S ^AMHTMP($J,AMHI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030MORE^T00030DOD^T00010AGE^T00001MESSAGEFLAG^T02500MESSAGE"_$C(30)
  1.  S AMHDUZ2=$P(AMHSTR,P)
  1.  S AMHPAT=$P(AMHSTR,P,2)
  1.  S AMHMT=$P(AMHSTR,P,3)
  1.  S AMHNPAT=$P(AMHSTR,P,4)
  1.  I '$G(AMHDUZ2) S AMHDUZ2=DUZ(2)
  1.  ;I AMHNPAT]"" S AMHPAT=AMHNPAT  ;cmi/maw 3/12/09 for testing
  1.  I AMHMT="ALL" S AMHMT=9999999
  1.  S AMHMT=(AMHMT-1)
  1.  I AMHPAT?9N D
  1.  . S AMHPIEN=$$PATSSN(AMHPAT)
  1.  I AMHPAT?1.7N D  ;ihs/cmi/maw 09/12/2012 AMH 4.0p4 allow for 7 digit chart numbers
  1.  . S AMHPIEN=$$PATCHT(.AMHPIEN,AMHPAT)
  1.  I AMHPAT?1.2N1"/"1.2N1"/"4N D
  1.  . S X=AMHPAT D ^%DT S AMHPAT=Y
  1.  . S AMHPIEN=$$PATDOB(.AMHPIEN,AMHPAT)
  1.  I '$G(AMHPIEN) D PATNAM(.AMHPIEN,AMHPAT,AMHNPAT)
  1.  I $G(AMHPIEN),'$G(AMHPATS) D PATADO(.AMHPIEN)
  1.  S ^AMHTMP($J,AMHI+1)=$C(31)
  1.  K AMHPAT,AMHPIEN,AMHCNT,AMHDA,AMHIEN,AMHPATE,AMHNM,AMHDB,AMHSX,AMHCT,AMHSSN,AMHDOD,AMHMORE,AMHAGE,AMHCNTR,AMHDG,AMHDUZ2,AMHMT,AMHNAM
  1.  K AMHPATS,AMHNPAT,AMHPI,AMHUPD
  1.  Q
  1.  ;
  1. PATSSN(PAT) ;EP -- look up by ssn
  1.  S AMHPIEN=$O(^DPT("SSN",PAT,0))
  1.  S AMHPIEN(1)=AMHPIEN
  1.  Q $G(AMHPIEN)
  1.  ;
  1. 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
  1.  N AMHCNT,AMHOEN
  1.  S AMHCNT=0,AMHPATE=0,AMHMCNT=0
  1.  S AMHDA=(PAT-1) F  S AMHDA=$O(^AUPNPAT("D",AMHDA)) Q:'AMHDA!(AMHDA>PAT)!(AMHCNT>AMHMT)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AUPNPAT("D",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. S AMHOEN=0 F  S AMHOEN=$O(^AUPNPAT("D",AMHDA,AMHIEN,AMHOEN)) Q:'AMHOEN!($G(AMHPIEN))  D
  1.  ... ;I $O(^AUPNPAT("D",AMHDA,AMHIEN,0))=AMHDUZ2 S AMHPIEN=AMHIEN
  1.  ... I AMHOEN=AMHDUZ2 S AMHPIEN=AMHIEN
  1.  ... Q:'$G(AMHPIEN)
  1.  ... S AMHCNT=AMHCNT+1
  1.  ... S:'$D(AMHPIEN(AMHCNT)) AMHPIEN(AMHCNT)=0
  1.  ... S AMHPIEN(AMHCNT)=AMHPIEN
  1.  Q $G(AMHPIEN)
  1.  ;
  1. PATDOB(AMHPATE,PAT) ;EP -- lookup by DOB
  1.  N AMHCNT
  1.  S AMHCNT=0,AMHPATE=0
  1.  S AMHDOB=PAT-1 F  S AMHDOB=$O(^DPT("ADOB",AMHDOB)) Q:'AMHDOB!(AMHDOB'=+PAT)!(AMHCNT>AMHMT)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^DPT("ADOB",AMHDOB,AMHIEN)) Q:'AMHIEN  D
  1.  .. S:'$D(AMHPATE(AMHCNT)) AMHPATE(AMHCNT)=0
  1.  .. S AMHCNT=AMHCNT+1,AMHPATE=1
  1.  .. S AMHPATE(AMHCNT)=AMHIEN
  1.  S AMHPATE=AMHCNT
  1.  Q $G(AMHPATE)
  1.  ;
  1. PATNAM(AMHPATE,PAT,NPAT) ;lookup by name
  1.  S AMHCNT=0,AMHPATE=0
  1.  N AMHLEN
  1.  S AMHLEN=$L(PAT)
  1.  S AMHNAM=PAT
  1.  S AMHNAM=$$BEGIN(PAT)
  1.  I $G(NPAT)]"" S AMHNAM=NPAT
  1.  F  S AMHNAM=$O(^DPT("B",AMHNAM)) Q:AMHNAM=""!($E(AMHNAM,1,AMHLEN)'=PAT)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^DPT("B",AMHNAM,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHOEN
  1.  .. I $O(^DPT("B",AMHNAM,AMHIEN,0)) D
  1.  ... S AMHOEN=0 F  S AMHOEN=$O(^DPT("B",AMHNAM,AMHIEN,AMHOEN)) Q:'AMHOEN  D
  1.  .... ;Q:$O(^DPT("B",AMHNAM,AMHIEN,0))  ;cmi/maw 4/25/2005 don't get aliases
  1.  .... S AMHCNT=AMHCNT+1
  1.  .... S:'$D(AMHPATE(AMHCNT)) AMHPATE(AMHCNT)=0
  1.  .... S AMHPATE(AMHCNT)=AMHIEN_U_AMHNAM
  1.  .. I '$O(^DPT("B",AMHNAM,AMHIEN,0)) D
  1.  ... S AMHCNT=AMHCNT+1
  1.  ... S:'$D(AMHPATE(AMHCNT)) AMHPATE(AMHCNT)=0
  1.  ... S AMHPATE(AMHCNT)=AMHIEN
  1.  S AMHPATE=AMHCNT
  1.  Q $G(AMHPATE)
  1.  ;
  1. BEGIN(PT) ;EP -- get begin point
  1.  N AMHPDA,AMHPIEN,AMHPCNT
  1.  S AMHPCNT=0
  1.  S AMHPDA=PT
  1.  I $O(^DPT("B",AMHPDA,0)) D
  1.  . S AMHPDA=$O(^DPT("B",AMHPDA),-1)
  1.  F  S AMHPDA=$O(^DPT("B",AMHPDA)) Q
  1.  I $G(AMHPDA)="" Q ""
  1.  Q $O(^DPT("B",AMHPDA),-1)
  1.  ;
  1. PATADO(PIEN) ;EP -- ado return
  1.  S AMHCNTR=0
  1.  S AMHDA=0 F  S AMHDA=$O(PIEN(AMHDA)) Q:'AMHDA  D
  1.  . S AMHPI=$P($G(PIEN(AMHDA)),U)
  1.  . S AMHAL=$P($G(PIEN(AMHDA)),U,2)
  1.  . Q:'$$GUIPL^AMHUTIL(AMHPI,DUZ,AMHDUZ2)  ;see if user is allowed to see patient
  1.  . ;D PTSEC^DGSEC4(.AMHDG,AMHPI,0)  ;logs patient, cant do here
  1.  . D DGSEC(.AMHDG,AMHPI,DUZ,0)  ;don't log patient but get sensitivity info for patient lookup
  1.  . N AMHDGMSG,AMHFLAG
  1.  . I $G(AMHDG(1)) D
  1.  .. S AMHFLAG=AMHDG(1)
  1.  .. N AMHDGDA
  1.  .. S AMHDGMSG=""
  1.  .. S AMHDGDA=1 F  S AMHDGDA=$O(AMHDG(AMHDGDA)) Q:'AMHDGDA  D
  1.  ... I $E(AMHDG(AMHDGDA),1,3)="* *" Q
  1.  ... S AMHDGMSG=AMHDGMSG_" "_$G(AMHDG(AMHDGDA))
  1.  . S AMHDGMSG=$TR($G(AMHDGMSG),"*")
  1.  . I AMHCNTR>AMHMT Q
  1.  . S AMHCNTR=AMHCNTR+1
  1.  . S AMHNM=$S(AMHAL]"":AMHAL_"  ",1:"")_$P($G(^DPT(AMHPI,0)),U)
  1.  . ;S AMHDB=$$FMTE^XLFDT($P($G(^DPT(AMHPI,0)),U,3))
  1.  . S AMHDB=$$LVDT^AMHGU($P($G(^DPT(AMHPI,0)),U,3))
  1.  . I $G(AMHFLAG),$G(AMHFLAG)'=4,$G(AMHFLAG)'=3 S AMHDB="**SENSITIVE**"
  1.  . S AMHSX=$P($G(^DPT(AMHPI,0)),U,2)
  1.  . S AMHCT=$$HRN^AUPNPAT(AMHPI,AMHDUZ2)
  1.  . S AMHSSN=$P($G(^DPT(AMHPI,0)),U,9)
  1.  . I AMHSSN]"" D
  1.  .. N LN
  1.  .. S LN=$L(AMHSSN)
  1.  .. S AMHSSN="XXX-XX-"_$E(AMHSSN,(LN-3),LN)
  1.  . I $G(AMHFLAG),$G(AMHFLAG)'=4,$G(AMHFLAG)'=3 S AMHSSN="**SENSITIVE**"
  1.  . S AMHUPD=$P($G(^AUPNPAT(AMHPI,0)),U,3)  ;cmi/maw 5/17/2007 added last reg update
  1.  . ;S AMHELG=$$GET1^DIQ(9000001,AMHPI,1111)  ;cmi/maw 5/17/2007 added class/ben for status bar
  1.  . S AMHDOD=$S($P($G(^DPT(AMHPI,.35)),U):$$LVDT^AMHGU($P($G(^DPT(AMHPI,.35)),U)),1:"")
  1.  . S AMHAGE=$$AGE^AUPNPAT(AMHPI,DT)
  1.  . I $G(AMHFLAG) S AMHAGE="**SENSITIVE**"
  1.  . I '$G(AMHFLAG),$$GET1^DIQ(43,1,9999999.01)="YES" S AMHFLAG=9  ;ihs/cmi/maw 12/6/2010 for track all patients spt
  1.  . S AMHI=AMHI+1
  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)
  1.  Q
  1.  ;
  1. PATSTR(RETVAL,AMHSTR) ;EP -- return the patient demographic information
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHERRR,AMHUIEN,P
  1.  S P="|"
  1.  K ^AMHTMP($J)
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  S AMHERRR=""
  1.  S ^AMHTMP($J,AMHI)="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030MORE^T00030DOD^T00010AGE^T00001MESSAGEFLAG^T02500MESSAGE"_$C(30)
  1.  S AMHPAT(1)=$P(AMHSTR,P,2)
  1.  S AMHDUZ2=$P(AMHSTR,P)
  1.  S AMHMT=9999999
  1.  D PATADO(.AMHPAT)
  1.  S ^AMHTMP($J,AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. LOGPAT(RETVAL,AMHSTR) ;-- log sensitive patient information
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHERRR,AMHPAT,P,AMHFLAG,AMHDGMSG,AMHDGDA,RESULT
  1.  S P="|"
  1.  K ^AMHTMP($J)
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  S AMHPAT=$P(AMHSTR,P)
  1.  D DGSEC(.RESULT,AMHPAT,DUZ,0)  ;cmi/maw 3/4/2010 logging takes place in NOTICE^DGSEC4
  1.  I $G(RESULT(1))=4 S AMHFLAG=1
  1.  I $G(RESULT(1))=3 S AMHFLAG=1
  1.  I '$G(AMHFLAG),$G(RESULT(1))'=0 D NOTICE^DGSEC4(.RESULT,AMHPAT,"AMHGRPC^Behavioral Health GUI",3)
  1.  I $G(RESULT(1))=0,$$GET1^DIQ(43,1,9999999.01)="YES" D  ;ihs/cmi/maw 12/6/2010 added for track all
  1.  . D NOTICE^DGSEC4(.RESULT,AMHPAT,"AMHGRPC^Behavioral Health GUI",$S($P($G(^DGSL(38.1,AMHPAT,0)),U,2):3,1:1))
  1.  S @RETVAL@(AMHI)="T00001Return"_$C(30)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=$G(RESULT)_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. DGSEC(RESULT,DFN,DUZ,DGMSG) ;EP -- mock the dgsec call but dont log, couldnt find a way to call PTSEC^DGSEC4 without logging
  1.  S DGMSG=$G(DGMSG,1)
  1.  I $$STATUS^BDGSPT2(DUZ,DFN,1)["RESTRICTED ACCESS" D  Q
  1.  .S RESULT(1)=5 Q:DGMSG'=1
  1.  .S RESULT(2)="Sorry, you are restricted from accessing this patient's record."
  1.  .S RESULT(3)="If you have questions, please contact your HIM department."
  1.  D OWNREC^DGSEC4(.RESULT,DFN,$G(DUZ),DGMSG)
  1.  I RESULT(1)=1 S RESULT(1)=3 Q
  1.  I RESULT(1)=2 S RESULT(1)=4 Q
  1.  K RESULT
  1.  D SENS^DGSEC4(.RESULT,DFN,$G(DUZ))
  1.  Q
  1.  ;