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

AMHGDA.m

Go to the documentation of this file. 
  1. AMHGDA ; IHS/CMI/MAW - AMHG Record Selector continued 4/28/2009 12:47:06 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1.  Q
  1. ADML(RETVAL,AMHSTR) ;-- get administrative data for record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00050Program^T00050ActivityCode^T00050POV^T00010Time^T00030Provider^T00080ProviderNarrative^T00030LocationofEncounter"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  N AMHTYP
  1.  S AMHTYP=$O(^AMHTSET("B","ADMINISTRATIVE",0))
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHREC("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHREC("AB",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHPRVM
  1.  .. S AMHPRVM=0
  1.  .. Q:$P($G(^AMHREC(AMHIEN,0)),U,7)'=AMHTYP
  1.  .. I $O(^AMHSITE(DUZ(2),16,"B",AMHP,0)) S AMHPRVM=1
  1.  .. I '$O(^AMHSITE(DUZ(2),16,"B",AMHP,0)) D
  1.  ... I $$PRV^AMHGU(AMHIEN,AMHP) S AMHPRVM=1 Q  ;quit if not provider who entered
  1.  ... I $$GET1^DIQ(9002011,AMHIEN,.19)=AMHP S AMHPRVM=1 Q
  1.  .. Q:'$G(AMHPRVM)
  1.  .. N AMHDT,AMHPRG,AMHAC,AMHACI,AMHTM,AMHPOVI,AMHPOV,AMHPRVN,AMHPRVI,AMHPRV,AMHPOVE,AMHLOC
  1.  .. S AMHDT=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
  1.  .. S AMHPRG=$$GET1^DIQ(9002011,AMHIEN,.02)
  1.  .. S AMHACI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
  1.  .. S AMHAC=$S(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
  1.  .. S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
  1.  .. I AMHPOVI S AMHPOVE=$P($G(^AMHRPRO(AMHPOVI,0)),U)
  1.  .. S AMHPOV=$S(AMHPOVE:$$GET1^DIQ(9002012.2,AMHPOVE,.02),1:"")
  1.  .. S AMHPRVN=$S(AMHPOVI:$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
  1.  .. S AMHTM=$$GET1^DIQ(9002011,AMHIEN,.12)
  1.  .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
  1.  .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  .. S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPRG_U_AMHAC_U_AMHPOV_U_AMHTM_U_AMHPRV_U_AMHPRVN_U_AMHLOC_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. COML(RETVAL,AMHSTR) ;-- get the community data for the record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00030Provider^T00010Time^T00050ActivityCode^T00050POV^T00080ProviderNarrative^T00030LocationofEncounter"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  N AMHTYP
  1.  S AMHTYP=$O(^AMHTSET("B","ADMINISTRATIVE",0))
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHREC("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHREC("AB",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHPRVM
  1.  .. S AMHPRVM=0
  1.  .. ;I $O(^AMHSITE(DUZ(2),16,"B",AMHP,0)) S AMHPRVM=1
  1.  .. ;I '$O(^AMHSITE(DUZ(2),16,"B",AMHP,0)) D
  1.  ..;. I $$PRV^AMHGU(AMHIEN,AMHP) S AMHPRVM=1  ;quit if not provider who entered
  1.  ..;. I $$GET1^DIQ(9002011,AMHIEN,.19,"I")=AMHP S AMHPRVM=1
  1.  .. Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHIEN)  ;screen on user and visit
  1.  .. Q:$P($G(^AMHREC(AMHIEN,0)),U,8)  ;quit if patient
  1.  .. ;Q:'$G(AMHPRVM)
  1.  .. ;Q:$P($G(^AMHREC(AMHIEN,0)),U,7)=AMHTYP  ;quit if administrative
  1.  .. ;Q:$$ACTCODE^AMHGU(AMHIEN)
  1.  .. N AMHDT,AMHPRG,AMHAC,AMHACI,AMHTM,AMHPOVI,AMHPOV,AMHPRVN,AMHPRVI,AMHPRV,AMHPOVE,AMHLOC
  1.  .. S AMHDT=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
  1.  .. S AMHACI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
  1.  .. S AMHAC=$S(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
  1.  .. S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
  1.  .. I AMHPOVI S AMHPOVE=$P($G(^AMHRPRO(AMHPOVI,0)),U)
  1.  .. S AMHPOV=$S($G(AMHPOVE)]"":$$GET1^DIQ(9002012.2,AMHPOVE,.02),1:"")
  1.  .. S AMHPRVN=$S(AMHPOVI:$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
  1.  .. S AMHTM=$$GET1^DIQ(9002011,AMHIEN,.12)
  1.  .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
  1.  .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  .. S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPRV_U_AMHTM_U_AMHAC_U_AMHPOV_U_AMHPRVN_U_AMHLOC_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. GROUPL(RETVAL,AMHSTR) ;-- get the group data for the record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00030GroupName^T00050ActivityCode^T00030Program^T00030Clinic^T00030Provider^T00030ContactType^T00080POV^T00001Signed^T00030LocationofEncounter"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.9999
  1.  S AMHIVE=(9999999-AMHE)-.0001
  1.  N AMHTYP
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHGROUP("AINV",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHGROUP("AINV",AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHPRVM
  1.  .. S AMHPRVM=0
  1.  .. Q:'$$ALLOWV^AMHUTIL(DUZ,$P(^AMHGROUP(AMHIEN,0),U,5))  ;not allowed to see this location
  1.  .. I $O(^AMHSITE(DUZ(2),16,"B",AMHP,0)) S AMHPRVM=1
  1.  .. I '$O(^AMHSITE(DUZ(2),16,"B",AMHP,0)) D
  1.  ... I $$PRVG^AMHGU(AMHIEN,AMHP) S AMHPRVM=1 Q  ;quit if not provider who entered
  1.  ... I $$GET1^DIQ(9002011.67,AMHIEN,.12,"I")=AMHP S AMHPRVM=1 Q
  1.  .. Q:'$G(AMHPRVM)
  1.  .. N AMHDT,AMHGRP,AMHACI,AMHAC,AMHPRG,AMHCLN,AMHPRVI,AMHPRV,AMHCT,AMHPOVI,AMHPOV,AMHPOVE,AMHESIG,AMHPOVN,AMHLOC
  1.  .. S AMHDT=$$GET1^DIQ(9002011.67,AMHIEN,.01,"I")
  1.  .. S AMHGRP=$$GET1^DIQ(9002011.67,AMHIEN,.03)
  1.  .. S AMHCT=$$GET1^DIQ(9002011.67,AMHIEN,.08)
  1.  .. S AMHPRG=$$GET1^DIQ(9002011.67,AMHIEN,.02)
  1.  .. S AMHCLN=$$GET1^DIQ(9002011.67,AMHIEN,.14)
  1.  .. S AMHPRVI=$$GETPRVG^AMHGU(AMHIEN,"P")
  1.  .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  .. S AMHACI=$$GET1^DIQ(9002011.67,AMHIEN,.07,"I")
  1.  .. S AMHAC=$S(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
  1.  .. S AMHPOVI=+$G(^AMHGROUP(AMHIEN,21,1,0))
  1.  .. S AMHPOVN=$P($G(^AMHGROUP(AMHIEN,21,1,0)),U,2)
  1.  .. S AMHPOV=$S($G(AMHPOVN):$$GET1^DIQ(9999999.27,AMHPOVN,.01),1:$$GET1^DIQ(9002012.2,AMHPOVI,.02))
  1.  .. S AMHESIG=$S('$$GET1^DIQ(9002011.67,AMHIEN,.18,"I"):"*",1:"")
  1.  .. S AMHLOC=$$GET1^DIQ(9002011.67,AMHIEN,.05)
  1.  .. ;S AMHPOV=$TR(AMHPOV,":"," ")
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHGRP_U_AMHAC_U_AMHPRG_U_AMHCLN_U_AMHPRV_U_AMHCT_U_AMHPOV_U_AMHESIG_U_AMHLOC_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. INTAKEL(RETVAL,AMHSTR) ;-- get intake for record selector screen
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
  1.  S P="|"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00050Program^T00050InitialProvider^T00007VisitIEN^T00030Visit^T00050PrimaryProvider"_$C(30)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.0001
  1.  S AMHIVE=(9999999-AMHE)-.9999
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHRINTK("AE",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . N AMHV
  1.  . S AMHV=0 F  S AMHV=$O(^AMHRINTK("AE",AMHP,AMHDA,AMHV)) Q:'AMHV  D
  1.  .. S AMHIEN=0 F  S AMHIEN=$O(^AMHRINTK("AE",AMHP,AMHDA,AMHV,AMHIEN)) Q:'AMHIEN  D
  1.  ... N AMHDE,AMHDEI,AMHPRG,AMHIP,AMHVDT,AMHPP,AMHPRVI,AMHPRV
  1.  ... S AMHDEI=$P($G(^AMHRINTK(AMHIEN,0)),U)
  1.  ... S AMHDE=AMHDEI
  1.  ... S AMHPRG=$$GET1^DIQ(9002011,AMHV,.02)
  1.  ... S AMHIP=$$GET1^DIQ(9002011.13,AMHIEN,.04)
  1.  ... S AMHVDT=$$GET1^DIQ(9002011,AMHV,.01,"I")
  1.  ... S AMHPRVI=$$GETPRV^AMHGU(AMHV,"P")
  1.  ... S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  ... S AMHI=AMHI+1
  1.  ... S @RETVAL@(AMHI)=AMHIEN_U_AMHDEI_U_$$LVDT^AMHGU(AMHDE)_U_AMHPRG_U_AMHIP_U_AMHV_U_$$LVDT^AMHGU(AMHVDT)_U_AMHPRV_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SPT(PIEN) ;EP -- check patient spt
  1.  N AMHFLAG
  1.  S AMHDGMSG=""
  1.  D DGSEC^AMHGP(.AMHDG,PIEN,DUZ,0)  ;don't log patient but get sensitivity info for patient lookup
  1.  ;D PTSEC^DGSEC4(.AMHDG,PIEN,0)
  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 $G(AMHFLAG),$G(AMHFLAG)'=4,$G(AMHFLAG)'=3 Q $G(AMHFLAG)
  1.  Q 0
  1.  ;