AMHGBPL ;ihs/cmi/maw - AMH GUI Problem List
;;4.0;IHS BEHAVIORAL HEALTH;**2,5**;JUN 02, 2010;Build 18
;
;
;
LIST(RETVAL,AMHSTR) ;-- get a list of problems for the listview
D ADO^AMHGU
N P
S P="|"
N AMHF,AMHPRB,AMHPIEN,AMHP0,AMHAF,AMHBPLPT,AMHI,AMHAI
N AMHDXI,AMHST,AMHLM,AMHDSM,AMHPN,AMHDO,AMHFAC,AMHUS,AMHUSI
N AMHC,AMHLR,AMHTNDF,AMHNIEN,AMHNT,AMHNAD,AMHNPN,AMHNAT,AMHNST
S AMHBPLPT=$P(AMHSTR,P)
S AMHAI=$P(AMHSTR,P,2)
S AMHI=0
S ^AMHTMP($J,AMHI)="T00010BMXIEN^T00010ID^T00007DXIEN^T00007DX^T00010Status^T00030LastModified^T00250DSMNarrative^T00250ProviderNarrative^T00030DateofOnset^T00030Facility^T00010Class^T00001Number^T00007UserWhoAddedIEN^T00030UserWhoAdded^"
S ^AMHTMP($J,AMHI)=^AMHTMP($J,AMHI)_"T00010NoteIEN^T00020NoteNumber^T00030NoteAdded^T00250NoteNarrative^T00030NoteAuthor^T00003NoteType^T00001NoteStatus^T00001Ecode1IEN^T00250Ecode1^T00001Ecode2IEN^T00250Ecode2^T00001Ecode3IEN"
S ^AMHTMP($J,AMHI)=^AMHTMP($J,AMHI)_"^T00250ECode3"_$C(30)
S AMHAI="A" D LISTG ;p5
S AMHAI="S" D LISTG ;p5
S AMHAI="O" D LISTG ;p5
S AMHAI="E" D LISTG ;p5
S AMHAI="I" D LISTG ;p5
S ^AMHTMP($J,AMHI+1)=$C(31)
Q
;
LISTH(RETVAL,AMHSTR) ;-- return the list header
D ADO^AMHGU
N P
S P="|"
N AMHBPLPT,AMHSX,AMHSX1,AMHSX2,AMHI
S AMHBPLPT=$P(AMHSTR,P)
S AMHI=0
S ^AMHTMP($J,AMHI)="T00250Header"_$C(30)
S AMHI=AMHI+1
S AMHSX=$$LASTPLR^AMHAPI6(AMHBPLPT,,DT,"A")
S ^AMHTMP($J,AMHI)=$S(AMHSX:"BH Problem List Reviewed On: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25),1:"")_$C(30)
S AMHI=AMHI+1
S AMHSX1=$$LASTPLU^AMHAPI6(AMHBPLPT,,DT,"A")
S ^AMHTMP($J,AMHI)=$S(AMHSX1:"BH Problem List Updated On: "_$$FMTE^XLFDT($P(AMHSX1,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX1,U,3),0)),U),1,25),1:"")_$C(30)
S AMHI=AMHI+1
S AMHSX2=$$LASTNAP^AMHAPI6(AMHBPLPT,,DT,"A")
S ^AMHTMP($J,AMHI)=$S(AMHSX2:"No Active BH Problems Documented On: "_$$FMTE^XLFDT($P(AMHSX2,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX2,U,3),0)),U),1,25),1:"")_$C(30)
S ^AMHTMP($J,AMHI+1)=$C(31)
Q
;
LISTG ;--get list
S AMHF=0 F S AMHF=$O(^AMHPPROB("AA",AMHBPLPT,AMHF)) Q:AMHF="" D
.S AMHPRB="" F S AMHPRB=$O(^AMHPPROB("AA",AMHBPLPT,AMHF,AMHPRB)) Q:AMHPRB="" D
..S AMHPIEN=AMHPRB
..S AMHP0=^AMHPPROB(AMHPIEN,0)
..I AMHAI'="B" Q:AMHAI'=$P(^AMHPPROB(AMHPIEN,0),U,12)
..Q:$P($G(^AMHPPROB(AMHPIEN,0)),U,12)="D"
..S AMHDXI=$$GET1^DIQ(9002011.51,AMHPIEN,.01,"I")
..S AMHDX=$$GET1^DIQ(9002011.51,AMHPIEN,.01)
..S AMHST=$$GET1^DIQ(9002011.51,AMHPIEN,.12)
..S AMHLM=$$DATE^AMHVRL($P(AMHP0,U,3))
..S AMHDSM=$$GET1^DIQ(9002012.2,$P(AMHP0,U),.02)
..S AMHPN=$$GET1^DIQ(9002011.51,AMHPIEN,.05)
..S AMHDO=$$DATE^AMHVRL($P(AMHP0,U,13))
..S AMHFAC=$$GET1^DIQ(9002011.51,AMHPIEN,.06)
..S AMHUSI=$$GET1^DIQ(9002011.51,AMHPIEN,.15,"I")
..S AMHUS=$$GET1^DIQ(9002011.51,AMHPIEN,.15)
..S AMHI=AMHI+1
..S ^AMHTMP($J,AMHI)=AMHPIEN_U_U_AMHDXI_U_AMHDX_U_AMHST_U_AMHLM_U_AMHDSM_U_AMHPN_U_AMHDO_U_AMHFAC_U_U_U_AMHUSI_U_AMHUS_$C(30)
.. ;lets get notes here
..Q:'$D(^AMHPTP("AE",AMHPIEN))
..S AMHC=0
..S AMHTNDF=0 F S AMHTNDF=$O(^AMHPTP("AE",AMHPIEN,AMHTNDF)) Q:'AMHTNDF D
...S AMHNIEN=0 F S AMHNIEN=$O(^AMHPTP("AE",AMHPIEN,AMHTNDF,AMHNIEN)) Q:AMHNIEN'=+AMHNIEN D
....S AMHLR=$$GET1^DIQ(9002011.53,AMHNIEN,.07,"I")
....S AMHLR=$S(AMHLR=1:"STP",AMHLR=2:"LTP",1:" ")
....S AMHC=AMHC+1
....S AMHNN=AMHLR_" #"_AMHC
....S AMHNAD=$S($P(^AMHPTP(AMHNIEN,0),U,5)]"":$$FMTE^XLFDT($P(^(0),U,5),5),1:"")
....S AMHNPN=$P(^AMHPTP(AMHNIEN,0),U,4)
....S AMHNAT=$$GET1^DIQ(9002011.53,AMHNIEN,.06)
....S AMHI=AMHI+1
....S ^AMHTMP($J,AMHI)=AMHPIEN_U_U_U_U_U_U_U_U_U_U_U_U_U_U_AMHNIEN_U_AMHNN_U_AMHNAD_U_AMHNPN_U_AMHNAT_U_AMHLR_$C(30)
Q
;
PLIST(RETVAL,AMHSTR) ;-- get a list of pcc problems for the listview
D ADO^AMHGU
N P
S P="|"
N AMHF,AMHPRB,AMHPIEN,AMHP0,AMHAF,AMHBPLPT,AMHI,AMHAI
N AMHDXI,AMHST,AMHLM,AMHDSM,AMHPN,AMHDO,AMHFAC,AMHUS,AMHUSI
N AMHC,AMHLR,AMHTNDF,AMHNIEN,AMHNT,AMHNAD,AMHNPN,AMHNAT,AMHNST
N AMHPN,AMHCLS,AMHPRBN,AMHST,AMHID,AMHPBN,AMHEC1I,AMHEC,AMHEC2I,AMHEC2,AMHEC3I,AMHEC3
S AMHBPLPT=$P(AMHSTR,P)
S AMHAI=$P(AMHSTR,P,2)
S AMHI=0
S ^AMHTMP($J,AMHI)="T00010BMXIEN^T00010ID^T00007DXIEN^T00007DX^T00010Status^T00030LastModified^T00250DSMNarrative^T00250ProviderNarrative^T00030DateofOnset^T00030Facility^T00010Class^T00010Number^T00007UserWhoAddedIEN^T00030UserWhoAdded^"
S ^AMHTMP($J,AMHI)=^AMHTMP($J,AMHI)_"T00010NoteIEN^T00020NoteNumber^T00030NoteAdded^T00250NoteNarrative^T00030NoteAuthor^T00003NoteType^T00001NoteStatus^T00001Ecode1IEN^T00250Ecode1^T00001Ecode2IEN^T00250Ecode2^T00001Ecode3IEN"
S ^AMHTMP($J,AMHI)=^AMHTMP($J,AMHI)_"^T00250ECode3"_$C(30)
I '$O(^AUPNPROB("AC",AMHBPLPT,0)) D Q
. S ^AMHTMP($J,AMHI+1)=$C(31)
S AMHAI="A" D PLISTG ;p5
S AMHAI="S" D PLISTG ;p5
S AMHAI="O" D PLISTG ;p5
S AMHAI="E" D PLISTG ;p5
S AMHAI="I" D PLISTG ;p5
S ^AMHTMP($J,AMHI+1)=$C(31)
Q
;
PLISTH(RETVAL,AMHSTR) ;-- return the list header
D ADO^AMHGU
N P
S P="|"
N AMHBPLPT,AMHSX,AMHI
S AMHBPLPT=$P(AMHSTR,P)
S AMHI=0
S ^AMHTMP($J,AMHI)="T00250Header"_$C(30)
S AMHI=AMHI+1
S AMHSX=$$LASTPLR^APCLAPI6(AMHBPLPT,,DT,"A")
S ^AMHTMP($J,AMHI)=$S(AMHSX:"Problem List Reviewed On: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25),1:"")_$C(30)
S AMHI=AMHI+1
S AMHSX=$$LASTPLU^APCLAPI6(AMHBPLPT,,DT,"A")
S ^AMHTMP($J,AMHI)=$S(AMHSX:"Problem List Updated On: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25),1:"")_$C(30)
S AMHI=AMHI+1
S AMHSX=$$LASTNAP^APCLAPI6(AMHBPLPT,,DT,"A")
S ^AMHTMP($J,AMHI)=$S(AMHSX:"No Active Problems Documented On: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25),1:"")_$C(30)
S ^AMHTMP($J,AMHI+1)=$C(31)
S ^AMHTMP($J,AMHI+1)=$C(31)
Q
;
PLISTG ;-- column sorter
S AMHF=0 F S AMHF=$O(^AUPNPROB("AA",AMHBPLPT,AMHF)) Q:'AMHF D
.S AMHPRBN="" F S AMHPRBN=$O(^AUPNPROB("AA",AMHBPLPT,AMHF,AMHPRBN)) Q:AMHPRBN="" D
..S AMHPRB=0 F S AMHPRB=$O(^AUPNPROB("AA",AMHBPLPT,AMHF,AMHPRBN,AMHPRB)) Q:'AMHPRB D
...S AMHPIEN=AMHPRB
...S AMHP0=^AUPNPROB(AMHPIEN,0)
...I AMHAI'="B" Q:AMHAI'=$P(^AUPNPROB(AMHPIEN,0),U,12)
...Q:$P($G(^AUPNPROB(AMHPIEN,0)),U,12)="D"
...S AMHDXI=$$GET1^DIQ(9000011,AMHPIEN,.01,"I")
...S AMHDX=$$GET1^DIQ(9000011,AMHPIEN,.01)
...S AMHST=$$GET1^DIQ(9000011,AMHPIEN,.12)
...S AMHPBN=$$GET1^DIQ(9000011,AMHPIEN,.07)
...S AMHCLS=$$GET1^DIQ(9000011,AMHPIEN,.04)
...S AMHLM=$$DATE^AMHVRL($P(AMHP0,U,3))
...S AMHDSM="" ;$$GET1^DIQ(9002012.2,$P(AMHP0,U),.02)
...S AMHPN=$$GET1^DIQ(9000011,AMHPIEN,.05)
...S AMHDO=$$DATE^AMHVRL($P(AMHP0,U,13))
...S AMHFAC=$$GET1^DIQ(9000011,AMHPIEN,.06)
...S AMHFACI=$P(AMHP0,U,6)
...I AMHFACI S AMHID=$J($P(^AUTTLOC(AMHFACI,0),U,7),4)_AMHPBN
...S AMHUSI=$$GET1^DIQ(9000011,AMHPIEN,.14,"I")
...S AMHUS=$$GET1^DIQ(9000011,AMHPIEN,.14)
...S AMHEC1I=$P(AMHP0,U,16)
...S AMHEC1=$$GET1^DIQ(9000011,AMHPIEN,.16)
...S AMHEC2I=$P(AMHP0,U,17)
...S AMHEC2=$$GET1^DIQ(9000011,AMHPIEN,.17)
...S AMHEC3I=$P(AMHP0,U,18)
...S AMHEC3=$$GET1^DIQ(9000011,AMHPIEN,.18)
...S AMHI=AMHI+1
...S ^AMHTMP($J,AMHI)=AMHPIEN_U_$G(AMHID)_U_AMHDXI_U_AMHDX_U_AMHST_U_AMHLM_U_AMHDSM_U_AMHPN_U_AMHDO_U_AMHFAC_U_AMHCLS_U_AMHPBN_U_AMHUSI_U_AMHUS_U_U_U_U_U_U_U_U_AMHEC1I_U_AMHEC1_U_AMHEC2I_U_AMHEC2_U_AMHEC3I_U_AMHEC3_$C(30)
... ;lets get notes here
...Q:'$D(^AUPNPROB(AMHPIEN,11))
...S AMHC=0
...S AMHTNDF=0 F S AMHTNDF=$O(^AUPNPROB(AMHPIEN,11,AMHTNDF)) Q:'AMHTNDF D
....S AMHNIEN=0 F S AMHNIEN=$O(^AUPNPROB(AMHPIEN,11,AMHTNDF,11,AMHNIEN)) Q:AMHNIEN'=+AMHNIEN D
.....N AMHN0,AMHNST
.....S AMHLR=""
.....S AMHN0=$G(^AUPNPROB(AMHPIEN,11,AMHTNDF,11,AMHNIEN,0))
.....S AMHNN=$P(AMHN0,U)
.....S AMHNAD=$S($P(AMHN0,U,5)]"":$$FMTE^XLFDT($P(AMHN0,U,5),5),1:"")
.....S AMHNPN=$P(AMHN0,U,3)
.....S AMHNAT=$S($P(AMHN0,U,6):$$GET1^DIQ(200,$P(AMHN0,U,6),.01),1:"")
.....S AMHNST=$P(AMHN0,U,4)
.....S AMHI=AMHI+1
.....S ^AMHTMP($J,AMHI)=AMHPIEN_U_U_U_U_U_U_U_U_U_U_U_U_U_U_AMHNIEN_U_AMHNN_U_AMHNAD_U_AMHNPN_U_AMHNAT_U_AMHLR_U_AMHNST_$C(30)
Q
;
DD(RETVAL,AMHSTR) ;-- display detail problem
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,P
S P="|"
S AMHPIEN=$P(AMHSTR,P)
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S @RETVAL@(AMHI)="T00250Data"_$C(30)
N AMHGUI
S AMHGUI=1
K DFN
S DA=AMHPIEN,DIC="^AMHPPROB("
D GUIR^XBLM("EN^DIQ","^XTMP(""AMHLV"",$J)")
I '$D(^XTMP("AMHLV",$J)) D Q
. S AMHI=AMHI+1
. S ^AMHTMP($J,AMHI)="NO DATA"_$C(30)
. S ^AMHTMP($J,AMHI+1)=$C(31)
S AMHDA=0 F S AMHDA=$O(^XTMP("AMHLV",$J,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHI=AMHI+1
. S AMHDATA=$G(^XTMP("AMHLV",$J,AMHDA))
. S @RETVAL@(AMHI)=AMHDATA_$C(30)
D GUIR^XBLM("DDN^AMHGBPL","^XTMP(""AMHLVN"",$J)")
S AMHDA=0 F S AMHDA=$O(^XTMP("AMHLVN",$J,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHI=AMHI+1
. S AMHDATA=$G(^XTMP("AMHLVN",$J,AMHDA))
. S @RETVAL@(AMHI)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
K ^XTMP("AMHLV",$J),^XTMP("AMHLVN",$J),DFN,ZTQUEUED,ZTIO,AMHZ,AMHPIEN
Q
;
DDN ;EP
K AMHNOTES
S AMHC=0
Q:'$D(^AMHPTP("AE",AMHPIEN))
W !,"Notes: "
S AMHTNDF=0 F AMHTQ=0:0 S AMHTNDF=$O(^AMHPTP("AE",AMHPIEN,AMHTNDF)) Q:'AMHTNDF D DSPN
Q
DSPN ; DISPLAY SINGLE NOTE
S X=$O(^AMHPTP("AE",AMHPIEN,AMHTNDF,"")) Q:X=""
S AMHC=AMHC+1
S AMHTN=^AMHPTP(X,0)
S AMHTDOI=$P(AMHTN,U,5) I AMHTDOI]"" S AMHTDOI=$$DATE^AMHVRL(AMHTDOI)
S AMHTTPT=$$VAL^XBDIQ1(9002011.53,X,.07) ;$P(AMHTN,U,7) S AMHTTPT=$S(AMHTTPT=1:"STP",AMHTTPT=2:"LTP",1:" ")
S AMHAUTH=$$VAL^XBDIQ1(9002011.53,X,.06)
W !!?3,AMHC,")",?7,"Date Added: ",AMHTDOI,?30,"Author: "_AMHAUTH
W !?3,"Note Narrative: "_$$VAL^XBDIQ1(9002011.53,X,.04)
I AMHTTPT]"" W !?3,AMHTTPT_" TERM TREATMENT"
S AMHNOTES(AMHC)=X
Q
;
PDD(RETVAL,AMHSTR) ;-- display detail problem
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHPIEN,P
S P="|"
S AMHPIEN=$P(AMHSTR,P)
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S @RETVAL@(AMHI)="T00250Data"_$C(30)
N AMHGUI
S AMHGUI=1
K DFN
S DA=AMHPIEN,DIC="^AUPNPROB("
D GUIR^XBLM("EN^DIQ","^XTMP(""AMHLV"",$J)")
I '$D(^XTMP("AMHLV",$J)) D Q
. S AMHI=AMHI+1
. S ^AMHTMP($J,AMHI)="NO DATA"_$C(30)
. S ^AMHTMP($J,AMHI+1)=$C(31)
S AMHDA=0 F S AMHDA=$O(^XTMP("AMHLV",$J,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHI=AMHI+1
. S AMHDATA=$G(^XTMP("AMHLV",$J,AMHDA))
. S @RETVAL@(AMHI)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
K ^XTMP("AMHLV",$J),DFN,ZTQUEUED,ZTIO,AMHZ
Q
;
DXCHK(RETVAL,AMHSTR) ;-- check to see if dx exists on pcc problem lsit
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHPAT,AMHDSM9,AMHHC,P,AMHPIEN,AMHDSMI
S P="|"
S AMHPAT=$P(AMHSTR,P)
S AMHPIEN=$P(AMHSTR,P,2)
S AMHI=0
S AMHHC=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S @RETVAL@(AMHI)="T00001Data"_$C(30)
S AMHDSMI=$P(^AMHPPROB(AMHPIEN,0),U,1)
S AMHDSM9=$P(^AMHPROB(AMHDSMI,0),U,5) ;icd9 code
I $$HASPROB^AMHBPL2(AMHPAT,AMHDSM9) S AMHHC=1
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHHC_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
NN(RETVAL,AMHSTR) ;-- return next problem number
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHPAT,P,AMHLOC,AMHDTL
S P="|"
S AMHPAT=$P(AMHSTR,P)
S AMHLOC=$P(AMHSTR,P,2)
I AMHLOC'?.N S AMHLOC=$O(^DIC(4,"B",AMHLOC,0))
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S @RETVAL@(AMHI)="T00010Number"_$C(30)
S X=0
S AMHDTY="" F S AMHDTY=$O(^AUPNPROB("AA",AMHPAT,AMHLOC,AMHDTY)) Q:AMHDTY="" D
. S X=$E(AMHDTY,2,4) S X=X+1
I X=0 S X=1
S AMHI=AMHI+1
S @RETVAL@(AMHI)=X_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
VALIDBH(RETVAL,AMHSTR) ;-- can this be passed to PCC
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHCD,P,AMHVL
S P="|"
S AMHCD=$P(AMHSTR,P)
S AMHVL=0
S AMHI=0
K ^AMHTMP($J)
S RETVAL="^AMHTMP("_$J_")"
S @RETVAL@(AMHI)="T00001Valid"_$C(30)
I $P($G(^AMHPROB(AMHCD,0)),U,5)]"" S AMHVL=1
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHVL_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGBPL ;ihs/cmi/maw - AMH GUI Problem List
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**2,5**;JUN 02, 2010;Build 18
+2 ;
+3 ;
+4 ;
LIST(RETVAL,AMHSTR) ;-- get a list of problems for the listview
+1 DO ADO^AMHGU
+2 NEW P
+3 SET P="|"
+4 NEW AMHF,AMHPRB,AMHPIEN,AMHP0,AMHAF,AMHBPLPT,AMHI,AMHAI
+5 NEW AMHDXI,AMHST,AMHLM,AMHDSM,AMHPN,AMHDO,AMHFAC,AMHUS,AMHUSI
+6 NEW AMHC,AMHLR,AMHTNDF,AMHNIEN,AMHNT,AMHNAD,AMHNPN,AMHNAT,AMHNST
+7 SET AMHBPLPT=$PIECE(AMHSTR,P)
+8 SET AMHAI=$PIECE(AMHSTR,P,2)
+9 SET AMHI=0
+10 SET ^AMHTMP($JOB,AMHI)="T00010BMXIEN^T00010ID^T00007DXIEN^T00007DX^T00010Status^T00030LastModified^T00250DSMNarrative^T00250ProviderNarrative^T00030DateofOnset^T00030Facility^T00010Class^T00001Number^T00007UserWhoAddedIEN^T00030UserWhoAdded^"
+11 SET ^AMHTMP($JOB,AMHI)=^AMHTMP($JOB,AMHI)_"T00010NoteIEN^T00020NoteNumber^T00030NoteAdded^T00250NoteNarrative^T00030NoteAuthor^T00003NoteType^T00001NoteStatus^T00001Ecode1IEN^T00250Ecode1^T00001Ecode2IEN^T00250Ecode2^T00001Ecode3IEN"
+12 SET ^AMHTMP($JOB,AMHI)=^AMHTMP($JOB,AMHI)_"^T00250ECode3"_$CHAR(30)
+13 ;p5
SET AMHAI="A"
DO LISTG
+14 ;p5
SET AMHAI="S"
DO LISTG
+15 ;p5
SET AMHAI="O"
DO LISTG
+16 ;p5
SET AMHAI="E"
DO LISTG
+17 ;p5
SET AMHAI="I"
DO LISTG
+18 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
LISTH(RETVAL,AMHSTR) ;-- return the list header
+1 DO ADO^AMHGU
+2 NEW P
+3 SET P="|"
+4 NEW AMHBPLPT,AMHSX,AMHSX1,AMHSX2,AMHI
+5 SET AMHBPLPT=$PIECE(AMHSTR,P)
+6 SET AMHI=0
+7 SET ^AMHTMP($JOB,AMHI)="T00250Header"_$CHAR(30)
+8 SET AMHI=AMHI+1
+9 SET AMHSX=$$LASTPLR^AMHAPI6(AMHBPLPT,,DT,"A")
+10 SET ^AMHTMP($JOB,AMHI)=$SELECT(AMHSX:"BH Problem List Reviewed On: "_$$FMTE^XLFDT($PIECE(AMHSX,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX,U,3),0)),U),1,25),1:"")_$CHAR(30)
+11 SET AMHI=AMHI+1
+12 SET AMHSX1=$$LASTPLU^AMHAPI6(AMHBPLPT,,DT,"A")
+13 SET ^AMHTMP($JOB,AMHI)=$SELECT(AMHSX1:"BH Problem List Updated On: "_$$FMTE^XLFDT($PIECE(AMHSX1,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX1,U,3),0)),U),1,25),1:"")_$CHAR(30)
+14 SET AMHI=AMHI+1
+15 SET AMHSX2=$$LASTNAP^AMHAPI6(AMHBPLPT,,DT,"A")
+16 SET ^AMHTMP($JOB,AMHI)=$SELECT(AMHSX2:"No Active BH Problems Documented On: "_$$FMTE^XLFDT($PIECE(AMHSX2,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX2,U,3),0)),U),1,25),1:"")_$CHAR(30)
+17 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
LISTG ;--get list
+1 SET AMHF=0
FOR
SET AMHF=$ORDER(^AMHPPROB("AA",AMHBPLPT,AMHF))
IF AMHF=""
QUIT
Begin DoDot:1
+2 SET AMHPRB=""
FOR
SET AMHPRB=$ORDER(^AMHPPROB("AA",AMHBPLPT,AMHF,AMHPRB))
IF AMHPRB=""
QUIT
Begin DoDot:2
+3 SET AMHPIEN=AMHPRB
+4 SET AMHP0=^AMHPPROB(AMHPIEN,0)
+5 IF AMHAI'="B"
IF AMHAI'=$PIECE(^AMHPPROB(AMHPIEN,0),U,12)
QUIT
+6 IF $PIECE($GET(^AMHPPROB(AMHPIEN,0)),U,12)="D"
QUIT
+7 SET AMHDXI=$$GET1^DIQ(9002011.51,AMHPIEN,.01,"I")
+8 SET AMHDX=$$GET1^DIQ(9002011.51,AMHPIEN,.01)
+9 SET AMHST=$$GET1^DIQ(9002011.51,AMHPIEN,.12)
+10 SET AMHLM=$$DATE^AMHVRL($PIECE(AMHP0,U,3))
+11 SET AMHDSM=$$GET1^DIQ(9002012.2,$PIECE(AMHP0,U),.02)
+12 SET AMHPN=$$GET1^DIQ(9002011.51,AMHPIEN,.05)
+13 SET AMHDO=$$DATE^AMHVRL($PIECE(AMHP0,U,13))
+14 SET AMHFAC=$$GET1^DIQ(9002011.51,AMHPIEN,.06)
+15 SET AMHUSI=$$GET1^DIQ(9002011.51,AMHPIEN,.15,"I")
+16 SET AMHUS=$$GET1^DIQ(9002011.51,AMHPIEN,.15)
+17 SET AMHI=AMHI+1
+18 SET ^AMHTMP($JOB,AMHI)=AMHPIEN_U_U_AMHDXI_U_AMHDX_U_AMHST_U_AMHLM_U_AMHDSM_U_AMHPN_U_AMHDO_U_AMHFAC_U_U_U_AMHUSI_U_AMHUS_$CHAR(30)
+19 ;lets get notes here
+20 IF '$DATA(^AMHPTP("AE",AMHPIEN))
QUIT
+21 SET AMHC=0
+22 SET AMHTNDF=0
FOR
SET AMHTNDF=$ORDER(^AMHPTP("AE",AMHPIEN,AMHTNDF))
IF 'AMHTNDF
QUIT
Begin DoDot:3
+23 SET AMHNIEN=0
FOR
SET AMHNIEN=$ORDER(^AMHPTP("AE",AMHPIEN,AMHTNDF,AMHNIEN))
IF AMHNIEN'=+AMHNIEN
QUIT
Begin DoDot:4
+24 SET AMHLR=$$GET1^DIQ(9002011.53,AMHNIEN,.07,"I")
+25 SET AMHLR=$SELECT(AMHLR=1:"STP",AMHLR=2:"LTP",1:" ")
+26 SET AMHC=AMHC+1
+27 SET AMHNN=AMHLR_" #"_AMHC
+28 SET AMHNAD=$SELECT($PIECE(^AMHPTP(AMHNIEN,0),U,5)]"":$$FMTE^XLFDT($PIECE(^(0),U,5),5),1:"")
+29 SET AMHNPN=$PIECE(^AMHPTP(AMHNIEN,0),U,4)
+30 SET AMHNAT=$$GET1^DIQ(9002011.53,AMHNIEN,.06)
+31 SET AMHI=AMHI+1
+32 SET ^AMHTMP($JOB,AMHI)=AMHPIEN_U_U_U_U_U_U_U_U_U_U_U_U_U_U_AMHNIEN_U_AMHNN_U_AMHNAD_U_AMHNPN_U_AMHNAT_U_AMHLR_$CHAR(30)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
PLIST(RETVAL,AMHSTR) ;-- get a list of pcc problems for the listview
+1 DO ADO^AMHGU
+2 NEW P
+3 SET P="|"
+4 NEW AMHF,AMHPRB,AMHPIEN,AMHP0,AMHAF,AMHBPLPT,AMHI,AMHAI
+5 NEW AMHDXI,AMHST,AMHLM,AMHDSM,AMHPN,AMHDO,AMHFAC,AMHUS,AMHUSI
+6 NEW AMHC,AMHLR,AMHTNDF,AMHNIEN,AMHNT,AMHNAD,AMHNPN,AMHNAT,AMHNST
+7 NEW AMHPN,AMHCLS,AMHPRBN,AMHST,AMHID,AMHPBN,AMHEC1I,AMHEC,AMHEC2I,AMHEC2,AMHEC3I,AMHEC3
+8 SET AMHBPLPT=$PIECE(AMHSTR,P)
+9 SET AMHAI=$PIECE(AMHSTR,P,2)
+10 SET AMHI=0
+11 SET ^AMHTMP($JOB,AMHI)="T00010BMXIEN^T00010ID^T00007DXIEN^T00007DX^T00010Status^T00030LastModified^T00250DSMNarrative^T00250ProviderNarrative^T00030DateofOnset^T00030Facility^T00010Class^T00010Number^T00007UserWhoAddedIEN^T00030UserWhoAdded^"
+12 SET ^AMHTMP($JOB,AMHI)=^AMHTMP($JOB,AMHI)_"T00010NoteIEN^T00020NoteNumber^T00030NoteAdded^T00250NoteNarrative^T00030NoteAuthor^T00003NoteType^T00001NoteStatus^T00001Ecode1IEN^T00250Ecode1^T00001Ecode2IEN^T00250Ecode2^T00001Ecode3IEN"
+13 SET ^AMHTMP($JOB,AMHI)=^AMHTMP($JOB,AMHI)_"^T00250ECode3"_$CHAR(30)
+14 IF '$ORDER(^AUPNPROB("AC",AMHBPLPT,0))
Begin DoDot:1
+15 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
End DoDot:1
QUIT
+16 ;p5
SET AMHAI="A"
DO PLISTG
+17 ;p5
SET AMHAI="S"
DO PLISTG
+18 ;p5
SET AMHAI="O"
DO PLISTG
+19 ;p5
SET AMHAI="E"
DO PLISTG
+20 ;p5
SET AMHAI="I"
DO PLISTG
+21 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+22 QUIT
+23 ;
PLISTH(RETVAL,AMHSTR) ;-- return the list header
+1 DO ADO^AMHGU
+2 NEW P
+3 SET P="|"
+4 NEW AMHBPLPT,AMHSX,AMHI
+5 SET AMHBPLPT=$PIECE(AMHSTR,P)
+6 SET AMHI=0
+7 SET ^AMHTMP($JOB,AMHI)="T00250Header"_$CHAR(30)
+8 SET AMHI=AMHI+1
+9 SET AMHSX=$$LASTPLR^APCLAPI6(AMHBPLPT,,DT,"A")
+10 SET ^AMHTMP($JOB,AMHI)=$SELECT(AMHSX:"Problem List Reviewed On: "_$$FMTE^XLFDT($PIECE(AMHSX,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX,U,3),0)),U),1,25),1:"")_$CHAR(30)
+11 SET AMHI=AMHI+1
+12 SET AMHSX=$$LASTPLU^APCLAPI6(AMHBPLPT,,DT,"A")
+13 SET ^AMHTMP($JOB,AMHI)=$SELECT(AMHSX:"Problem List Updated On: "_$$FMTE^XLFDT($PIECE(AMHSX,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX,U,3),0)),U),1,25),1:"")_$CHAR(30)
+14 SET AMHI=AMHI+1
+15 SET AMHSX=$$LASTNAP^APCLAPI6(AMHBPLPT,,DT,"A")
+16 SET ^AMHTMP($JOB,AMHI)=$SELECT(AMHSX:"No Active Problems Documented On: "_$$FMTE^XLFDT($PIECE(AMHSX,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX,U,3),0)),U),1,25),1:"")_$CHAR(30)
+17 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+18 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
PLISTG ;-- column sorter
+1 SET AMHF=0
FOR
SET AMHF=$ORDER(^AUPNPROB("AA",AMHBPLPT,AMHF))
IF 'AMHF
QUIT
Begin DoDot:1
+2 SET AMHPRBN=""
FOR
SET AMHPRBN=$ORDER(^AUPNPROB("AA",AMHBPLPT,AMHF,AMHPRBN))
IF AMHPRBN=""
QUIT
Begin DoDot:2
+3 SET AMHPRB=0
FOR
SET AMHPRB=$ORDER(^AUPNPROB("AA",AMHBPLPT,AMHF,AMHPRBN,AMHPRB))
IF 'AMHPRB
QUIT
Begin DoDot:3
+4 SET AMHPIEN=AMHPRB
+5 SET AMHP0=^AUPNPROB(AMHPIEN,0)
+6 IF AMHAI'="B"
IF AMHAI'=$PIECE(^AUPNPROB(AMHPIEN,0),U,12)
QUIT
+7 IF $PIECE($GET(^AUPNPROB(AMHPIEN,0)),U,12)="D"
QUIT
+8 SET AMHDXI=$$GET1^DIQ(9000011,AMHPIEN,.01,"I")
+9 SET AMHDX=$$GET1^DIQ(9000011,AMHPIEN,.01)
+10 SET AMHST=$$GET1^DIQ(9000011,AMHPIEN,.12)
+11 SET AMHPBN=$$GET1^DIQ(9000011,AMHPIEN,.07)
+12 SET AMHCLS=$$GET1^DIQ(9000011,AMHPIEN,.04)
+13 SET AMHLM=$$DATE^AMHVRL($PIECE(AMHP0,U,3))
+14 ;$$GET1^DIQ(9002012.2,$P(AMHP0,U),.02)
SET AMHDSM=""
+15 SET AMHPN=$$GET1^DIQ(9000011,AMHPIEN,.05)
+16 SET AMHDO=$$DATE^AMHVRL($PIECE(AMHP0,U,13))
+17 SET AMHFAC=$$GET1^DIQ(9000011,AMHPIEN,.06)
+18 SET AMHFACI=$PIECE(AMHP0,U,6)
+19 IF AMHFACI
SET AMHID=$JUSTIFY($PIECE(^AUTTLOC(AMHFACI,0),U,7),4)_AMHPBN
+20 SET AMHUSI=$$GET1^DIQ(9000011,AMHPIEN,.14,"I")
+21 SET AMHUS=$$GET1^DIQ(9000011,AMHPIEN,.14)
+22 SET AMHEC1I=$PIECE(AMHP0,U,16)
+23 SET AMHEC1=$$GET1^DIQ(9000011,AMHPIEN,.16)
+24 SET AMHEC2I=$PIECE(AMHP0,U,17)
+25 SET AMHEC2=$$GET1^DIQ(9000011,AMHPIEN,.17)
+26 SET AMHEC3I=$PIECE(AMHP0,U,18)
+27 SET AMHEC3=$$GET1^DIQ(9000011,AMHPIEN,.18)
+28 SET AMHI=AMHI+1
+29 SET ^AMHTMP($JOB,AMHI)=AMHPIEN_U_$GET(AMHID)_U_AMHDXI_U_AMHDX_U_AMHST_U_AMHLM_U_AMHDSM_U_AMHPN_U_AMHDO_U_AMHFAC_U_AMHCLS_U_AMHPBN_U_AMHUSI_U_AMHUS_U_U_U_U_U_U_U_U_AMHEC1I_U_AMHEC1_U_AMHEC2I_U_AMHEC2_U_AMHEC3I_U_AMHEC3_$C
HAR(30)
+30 ;lets get notes here
+31 IF '$DATA(^AUPNPROB(AMHPIEN,11))
QUIT
+32 SET AMHC=0
+33 SET AMHTNDF=0
FOR
SET AMHTNDF=$ORDER(^AUPNPROB(AMHPIEN,11,AMHTNDF))
IF 'AMHTNDF
QUIT
Begin DoDot:4
+34 SET AMHNIEN=0
FOR
SET AMHNIEN=$ORDER(^AUPNPROB(AMHPIEN,11,AMHTNDF,11,AMHNIEN))
IF AMHNIEN'=+AMHNIEN
QUIT
Begin DoDot:5
+35 NEW AMHN0,AMHNST
+36 SET AMHLR=""
+37 SET AMHN0=$GET(^AUPNPROB(AMHPIEN,11,AMHTNDF,11,AMHNIEN,0))
+38 SET AMHNN=$PIECE(AMHN0,U)
+39 SET AMHNAD=$SELECT($PIECE(AMHN0,U,5)]"":$$FMTE^XLFDT($PIECE(AMHN0,U,5),5),1:"")
+40 SET AMHNPN=$PIECE(AMHN0,U,3)
+41 SET AMHNAT=$SELECT($PIECE(AMHN0,U,6):$$GET1^DIQ(200,$PIECE(AMHN0,U,6),.01),1:"")
+42 SET AMHNST=$PIECE(AMHN0,U,4)
+43 SET AMHI=AMHI+1
+44 SET ^AMHTMP($JOB,AMHI)=AMHPIEN_U_U_U_U_U_U_U_U_U_U_U_U_U_U_AMHNIEN_U_AMHNN_U_AMHNAD_U_AMHNPN_U_AMHNAT_U_AMHLR_U_AMHNST_$CHAR(30)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+45 QUIT
+46 ;
DD(RETVAL,AMHSTR) ;-- display detail problem
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,P
+3 SET P="|"
+4 SET AMHPIEN=$PIECE(AMHSTR,P)
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET RETVAL="^AMHTMP("_$JOB_")"
+8 SET @RETVAL@(AMHI)="T00250Data"_$CHAR(30)
+9 NEW AMHGUI
+10 SET AMHGUI=1
+11 KILL DFN
+12 SET DA=AMHPIEN
SET DIC="^AMHPPROB("
+13 DO GUIR^XBLM("EN^DIQ","^XTMP(""AMHLV"",$J)")
+14 IF '$DATA(^XTMP("AMHLV",$JOB))
Begin DoDot:1
+15 SET AMHI=AMHI+1
+16 SET ^AMHTMP($JOB,AMHI)="NO DATA"_$CHAR(30)
+17 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
End DoDot:1
QUIT
+18 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^XTMP("AMHLV",$JOB,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+19 NEW AMHDATA
+20 SET AMHI=AMHI+1
+21 SET AMHDATA=$GET(^XTMP("AMHLV",$JOB,AMHDA))
+22 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:1
+23 DO GUIR^XBLM("DDN^AMHGBPL","^XTMP(""AMHLVN"",$J)")
+24 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^XTMP("AMHLVN",$JOB,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+25 NEW AMHDATA
+26 SET AMHI=AMHI+1
+27 SET AMHDATA=$GET(^XTMP("AMHLVN",$JOB,AMHDA))
+28 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:1
+29 SET @RETVAL@(AMHI+1)=$CHAR(31)
+30 KILL ^XTMP("AMHLV",$JOB),^XTMP("AMHLVN",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ,AMHPIEN
+31 QUIT
+32 ;
DDN ;EP
+1 KILL AMHNOTES
+2 SET AMHC=0
+3 IF '$DATA(^AMHPTP("AE",AMHPIEN))
QUIT
+4 WRITE !,"Notes: "
+5 SET AMHTNDF=0
FOR AMHTQ=0:0
SET AMHTNDF=$ORDER(^AMHPTP("AE",AMHPIEN,AMHTNDF))
IF 'AMHTNDF
QUIT
DO DSPN
+6 QUIT
DSPN ; DISPLAY SINGLE NOTE
+1 SET X=$ORDER(^AMHPTP("AE",AMHPIEN,AMHTNDF,""))
IF X=""
QUIT
+2 SET AMHC=AMHC+1
+3 SET AMHTN=^AMHPTP(X,0)
+4 SET AMHTDOI=$PIECE(AMHTN,U,5)
IF AMHTDOI]""
SET AMHTDOI=$$DATE^AMHVRL(AMHTDOI)
+5 ;$P(AMHTN,U,7) S AMHTTPT=$S(AMHTTPT=1:"STP",AMHTTPT=2:"LTP",1:" ")
SET AMHTTPT=$$VAL^XBDIQ1(9002011.53,X,.07)
+6 SET AMHAUTH=$$VAL^XBDIQ1(9002011.53,X,.06)
+7 WRITE !!?3,AMHC,")",?7,"Date Added: ",AMHTDOI,?30,"Author: "_AMHAUTH
+8 WRITE !?3,"Note Narrative: "_$$VAL^XBDIQ1(9002011.53,X,.04)
+9 IF AMHTTPT]""
WRITE !?3,AMHTTPT_" TERM TREATMENT"
+10 SET AMHNOTES(AMHC)=X
+11 QUIT
+12 ;
PDD(RETVAL,AMHSTR) ;-- display detail problem
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHDA,AMHI,AMHPAT,AMHTYPE,AMHCALL,AMHPIEN,P
+3 SET P="|"
+4 SET AMHPIEN=$PIECE(AMHSTR,P)
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET RETVAL="^AMHTMP("_$JOB_")"
+8 SET @RETVAL@(AMHI)="T00250Data"_$CHAR(30)
+9 NEW AMHGUI
+10 SET AMHGUI=1
+11 KILL DFN
+12 SET DA=AMHPIEN
SET DIC="^AUPNPROB("
+13 DO GUIR^XBLM("EN^DIQ","^XTMP(""AMHLV"",$J)")
+14 IF '$DATA(^XTMP("AMHLV",$JOB))
Begin DoDot:1
+15 SET AMHI=AMHI+1
+16 SET ^AMHTMP($JOB,AMHI)="NO DATA"_$CHAR(30)
+17 SET ^AMHTMP($JOB,AMHI+1)=$CHAR(31)
End DoDot:1
QUIT
+18 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^XTMP("AMHLV",$JOB,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+19 NEW AMHDATA
+20 SET AMHI=AMHI+1
+21 SET AMHDATA=$GET(^XTMP("AMHLV",$JOB,AMHDA))
+22 SET @RETVAL@(AMHI)=AMHDATA_$CHAR(30)
End DoDot:1
+23 SET @RETVAL@(AMHI+1)=$CHAR(31)
+24 KILL ^XTMP("AMHLV",$JOB),DFN,ZTQUEUED,ZTIO,AMHZ
+25 QUIT
+26 ;
DXCHK(RETVAL,AMHSTR) ;-- check to see if dx exists on pcc problem lsit
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHPAT,AMHDSM9,AMHHC,P,AMHPIEN,AMHDSMI
+3 SET P="|"
+4 SET AMHPAT=$PIECE(AMHSTR,P)
+5 SET AMHPIEN=$PIECE(AMHSTR,P,2)
+6 SET AMHI=0
+7 SET AMHHC=0
+8 KILL ^AMHTMP($JOB)
+9 SET RETVAL="^AMHTMP("_$JOB_")"
+10 SET @RETVAL@(AMHI)="T00001Data"_$CHAR(30)
+11 SET AMHDSMI=$PIECE(^AMHPPROB(AMHPIEN,0),U,1)
+12 ;icd9 code
SET AMHDSM9=$PIECE(^AMHPROB(AMHDSMI,0),U,5)
+13 IF $$HASPROB^AMHBPL2(AMHPAT,AMHDSM9)
SET AMHHC=1
+14 SET AMHI=AMHI+1
+15 SET @RETVAL@(AMHI)=AMHHC_$CHAR(30)
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
NN(RETVAL,AMHSTR) ;-- return next problem number
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHPAT,P,AMHLOC,AMHDTL
+3 SET P="|"
+4 SET AMHPAT=$PIECE(AMHSTR,P)
+5 SET AMHLOC=$PIECE(AMHSTR,P,2)
+6 IF AMHLOC'?.N
SET AMHLOC=$ORDER(^DIC(4,"B",AMHLOC,0))
+7 SET AMHI=0
+8 KILL ^AMHTMP($JOB)
+9 SET RETVAL="^AMHTMP("_$JOB_")"
+10 SET @RETVAL@(AMHI)="T00010Number"_$CHAR(30)
+11 SET X=0
+12 SET AMHDTY=""
FOR
SET AMHDTY=$ORDER(^AUPNPROB("AA",AMHPAT,AMHLOC,AMHDTY))
IF AMHDTY=""
QUIT
Begin DoDot:1
+13 SET X=$EXTRACT(AMHDTY,2,4)
SET X=X+1
End DoDot:1
+14 IF X=0
SET X=1
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=X_$CHAR(30)
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
VALIDBH(RETVAL,AMHSTR) ;-- can this be passed to PCC
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHCD,P,AMHVL
+3 SET P="|"
+4 SET AMHCD=$PIECE(AMHSTR,P)
+5 SET AMHVL=0
+6 SET AMHI=0
+7 KILL ^AMHTMP($JOB)
+8 SET RETVAL="^AMHTMP("_$JOB_")"
+9 SET @RETVAL@(AMHI)="T00001Valid"_$CHAR(30)
+10 IF $PIECE($GET(^AMHPROB(AMHCD,0)),U,5)]""
SET AMHVL=1
+11 SET AMHI=AMHI+1
+12 SET @RETVAL@(AMHI)=AMHVL_$CHAR(30)
+13 SET @RETVAL@(AMHI+1)=$CHAR(31)
+14 QUIT
+15 ;
