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