AMHGBPL.m

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))