AMHBPL ; IHS/CMI/LAB - PROBLEM LIST UPDATE ;
;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
;; ;
START(AMHR) ;EP
I '$G(AMHR) Q
I '$D(^AMHREC(AMHR,0)) Q
NEW DFN,AMHPAT,AMHLOC,AMHDATE,AMHBHPL,AMHLINE,AMHPRCNT
S (DFN,AMHPAT)=$P($G(^AMHREC(AMHR,0)),U,8)
S AMHDATE=$P($P(^AMHREC(AMHR,0),U,1),".")
S AMHLOC=$P(^AMHREC(AMHR,0),U,4)
S AMHOVRR=1
S APCDOVRR=1
I '$G(AUPNDOB) S Y=DFN D ^AUPNPAT
D EN1
D FULL^VALM1
D EXIT
;D EOJ
Q
EOJ ;End of job cleanup
D:$D(VALMWD) CLEAR^VALM1 ;clears out all list man stuff
K ^TMP($J,"AMHBPL")
K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF,VALMMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW
K AMHBPLPT,AMHLOC,AMHPAT,AMHDATE,AMHPIEN,AMHAF,AMHPRB,AMHLOOK,AMHPDFN
;D KILL^AUPNPAT
Q
EN1 ;PEP - requires DFN to be set to patient
K ^TMP($J,"AMHBPL")
Q:'$G(DFN)
S AMHBPLPT=DFN
Q:'$G(AMHBPLPT)
Q:'$D(^AUPNPAT(AMHBPLPT))
Q:'$D(^DPT(AMHBPLPT))
;S Y=AMHBPLPT D ^AUPNPAT
S AMHOVRR=1
D EN
K AMHBPLPT
D FULL^VALM1
D EXIT
Q
EN ;PEP main entry point for AMH BHPL PROBLEM LIST
S VALMCC=1 ;1 means screen mode, 0 means scrolling mode
D EN^VALM("AMH BHPL PROBLEM LIST")
D CLEAR^VALM1
Q
;
HDR ;EP -- header code
S VALMHDR(1)=$TR($J(" ",80)," ","-")
S VALMHDR(2)="Patient Name: "_IORVON_$P(^DPT(AMHBPLPT,0),U)_IOINORM_" DOB: "_$$FTIME^VALM1(AUPNDOB)_" Sex: "_$P(^DPT(AMHBPLPT,0),U,2)_" HRN: "_$S($D(^AUPNPAT(AMHBPLPT,41,DUZ(2),0)):$P(^AUPNPAT(AMHBPLPT,41,DUZ(2),0),U,2),1:"????")
S VALMHDR(3)=$TR($J(" ",80)," ","-")
Q
;
INIT ; -- init variables and list array
D GATHER ;gather up all problems
S VALMCNT=AMHLINE ;this variable must be the total number of lines in list
S AMHOVRR="" ;for provider narrative lookup
Q
;
GATHER ;EP
;set up array containing list of problems
;**** see page 7 of List Manager Manual for info on how to
;**** set up the array that contains the list
K AMHBHPL
NEW AMHSX,AMHAF,AMHF,AMHPIEN,AMHPRB,AMHP0,AMHX,AMHC,AMHLR
K AMHQUIT,AMHBPL S AMHPRCNT=0,AMHLINE=0
I '$D(^AMHPPROB("AC",AMHBPLPT)) S AMHBHPL(1,0)="No BH Problems currently on file",AMHBHPL("IDX",1,1)="" S AMHLINE=1 ;Q
S AMHSX=$$LASTPLR^AMHAPI6(AMHBPLPT,,DT,"A")
I AMHSX S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)="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)
S AMHSX=$$LASTPLU^AMHAPI6(AMHBPLPT,,DT,"A")
I AMHSX S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)="BH Problem List Updated On: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25)
S AMHSX=$$LASTNAP^AMHAPI6(AMHBPLPT,,DT,"A")
;I '$$ANYACTP^AMHAPRB(AMHBPLPT),AMHSX S AMHLINE=AMHLINE+1,^TMP($J,"AMHBPL",AMHLINE,0)="No Active BH Problems: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" Documented By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25)
I AMHSX S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)="No Active BH Problems Documented On: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25)
S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)=" "
S AMHPRCNT=0
S AMHAF="A" D GATHER1 S AMHAF="I" D GATHER1
Q
GATHER1 ;
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,AMHP0=^AMHPPROB(AMHPIEN,0)
..Q:AMHAF'=$P(^AMHPPROB(AMHPIEN,0),U,12)
..;quit if not meet UU
..;Q:'$$ALLOWV^AMHUTIL(DUZ,$P(^AMHPPROB(AMHPIEN,0),U,6)) no UU per Wendy
..S AMHPRCNT=AMHPRCNT+1,AMHLINE=AMHLINE+1,AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN,AMHX=""
..S AMHX=AMHPRCNT,AMHX=AMHX_") ",$E(AMHX,6)="DX: "_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.01),$E(AMHX,20)="Status: "_IOUON_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.12)_IOUOFF,$E(AMHX,50)="Last Modified: "_$$DATE^AMHVRL($P(AMHP0,U,3))
..S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
..S AMHLINE=AMHLINE+1
..S $E(AMHX,6)="DSM Narrative: "_$$VAL^XBDIQ1(9002012.2,$P(AMHP0,U,1),.02)
..S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
..S AMHLINE=AMHLINE+1
..S $E(AMHX,6)="Provider Narrative: "_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.05)
..S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
..S AMHLINE=AMHLINE+1
..S $E(AMHX,6)="Date of Onset: "_$$DATE^AMHVRL($P(AMHP0,U,13))_" Facility: "_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.06)
..S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
NOTE ..;
..I '$D(^AMHPTP("AE",AMHPIEN)) D Q
...S AMHLINE=AMHLINE+1
...S AMHX=""
...S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=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 AMHC=AMHC+1 I AMHC=1 S X=IOINORM_" "_IORVON_"Notes:"_IORVOFF S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)=X,AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
....S AMHLR=$$VALI^XBDIQ1(9002011.53,AMHNIEN,.07) S AMHLR=$S(AMHLR=1:"STP",AMHLR=2:"LTP",1:" ")
....S X=" "_AMHLR_" Note #"_AMHC_" Added: "_$S($P(^AMHPTP(AMHNIEN,0),U,5)]"":$$FMTE^XLFDT($P(^(0),U,5),5),1:" ")
....S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)=X,AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
....S X=" Narrative: "_$P(^AMHPTP(AMHNIEN,0),U,4)
...S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)=X,AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
..S AMHLINE=AMHLINE+1,AMHBHPL(AMHLINE,0)=IOINORM_" ",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
..;S AMHLINE=AMHLINE+1
..;S AMHX=""
..;S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
.Q
K AMHLR,AMHL,AMHX,AMHF
Q
TEXT ;
;;
;;*****************************************************
;;* Update Behavioral Health/PCC Patient Problem List *
;;*****************************************************
;;
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K AMHBHPL
K AMHPRCNT,AMHBPL,AMHLINE,AMHX,AMHP0,AMHC,AMHL,AMHLR,AMHPIEN,AMHAF,AMHPRB,AMHOVRR,AMHLOOK,AMHPDFN,AMHLOC,AMHDATE
K X,Y
K VALMHDR
Q
;
EXPND ; -- expand code
Q
;
ANYNONUU(P,R) ;EP - any problem that is allowed to be seen?
NEW G,A,B,C
I '$G(P) Q ""
I '$G(R) Q ""
S G=0
S A=0 F S A=$O(^AMHPPROB("AC",P,A)) Q:A'=+A!(G) D
.Q:$P(^AMHPPROB(A,0),U,12)="D" Q ;deleted
.S B=$P(^AMHPPROB(A,0),U,6)
.Q:'$$ALLOWV^AMHUTIL(R,B)
.S G=1
Q G
AMHBPL ; IHS/CMI/LAB - PROBLEM LIST UPDATE ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
+2 ;; ;
START(AMHR) ;EP
+1 IF '$GET(AMHR)
QUIT
+2 IF '$DATA(^AMHREC(AMHR,0))
QUIT
+3 NEW DFN,AMHPAT,AMHLOC,AMHDATE,AMHBHPL,AMHLINE,AMHPRCNT
+4 SET (DFN,AMHPAT)=$PIECE($GET(^AMHREC(AMHR,0)),U,8)
+5 SET AMHDATE=$PIECE($PIECE(^AMHREC(AMHR,0),U,1),".")
+6 SET AMHLOC=$PIECE(^AMHREC(AMHR,0),U,4)
+7 SET AMHOVRR=1
+8 SET APCDOVRR=1
+9 IF '$GET(AUPNDOB)
SET Y=DFN
DO ^AUPNPAT
+10 DO EN1
+11 DO FULL^VALM1
+12 DO EXIT
+13 ;D EOJ
+14 QUIT
EOJ ;End of job cleanup
+1 ;clears out all list man stuff
IF $DATA(VALMWD)
DO CLEAR^VALM1
+2 KILL ^TMP($JOB,"AMHBPL")
+3 KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF,VALMMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW
+4 KILL AMHBPLPT,AMHLOC,AMHPAT,AMHDATE,AMHPIEN,AMHAF,AMHPRB,AMHLOOK,AMHPDFN
+5 ;D KILL^AUPNPAT
+6 QUIT
EN1 ;PEP - requires DFN to be set to patient
+1 KILL ^TMP($JOB,"AMHBPL")
+2 IF '$GET(DFN)
QUIT
+3 SET AMHBPLPT=DFN
+4 IF '$GET(AMHBPLPT)
QUIT
+5 IF '$DATA(^AUPNPAT(AMHBPLPT))
QUIT
+6 IF '$DATA(^DPT(AMHBPLPT))
QUIT
+7 ;S Y=AMHBPLPT D ^AUPNPAT
+8 SET AMHOVRR=1
+9 DO EN
+10 KILL AMHBPLPT
+11 DO FULL^VALM1
+12 DO EXIT
+13 QUIT
EN ;PEP main entry point for AMH BHPL PROBLEM LIST
+1 ;1 means screen mode, 0 means scrolling mode
SET VALMCC=1
+2 DO EN^VALM("AMH BHPL PROBLEM LIST")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ;EP -- header code
+1 SET VALMHDR(1)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+2 SET VALMHDR(2)="Patient Name: "_IORVON_$PIECE(^DPT(AMHBPLPT,0),U)_IOINORM_" DOB: "_$$FTIME^VALM1(AUPNDOB)_" Sex: "_$PIECE(^DPT(AMHBPLPT,0),U,2)_" HRN: "_$SELECT(...
... $DATA(^AUPNPAT(AMHBPLPT,41,DUZ(2),0)):$PIECE(^AUPNPAT(AMHBPLPT,41,DUZ(2),0),U,2),1:"????")
+3 SET VALMHDR(3)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 ;gather up all problems
DO GATHER
+2 ;this variable must be the total number of lines in list
SET VALMCNT=AMHLINE
+3 ;for provider narrative lookup
SET AMHOVRR=""
+4 QUIT
+5 ;
GATHER ;EP
+1 ;set up array containing list of problems
+2 ;**** see page 7 of List Manager Manual for info on how to
+3 ;**** set up the array that contains the list
+4 KILL AMHBHPL
+5 NEW AMHSX,AMHAF,AMHF,AMHPIEN,AMHPRB,AMHP0,AMHX,AMHC,AMHLR
+6 KILL AMHQUIT,AMHBPL
SET AMHPRCNT=0
SET AMHLINE=0
+7 ;Q
IF '$DATA(^AMHPPROB("AC",AMHBPLPT))
SET AMHBHPL(1,0)="No BH Problems currently on file"
SET AMHBHPL("IDX",1,1)=""
SET AMHLINE=1
+8 SET AMHSX=$$LASTPLR^AMHAPI6(AMHBPLPT,,DT,"A")
+9 IF AMHSX
SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)="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)
+10 SET AMHSX=$$LASTPLU^AMHAPI6(AMHBPLPT,,DT,"A")
+11 IF AMHSX
SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)="BH Problem List Updated On: "_$$FMTE^XLFDT($PIECE(AMHSX,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX,U,3),0)),U),1,25)
+12 SET AMHSX=$$LASTNAP^AMHAPI6(AMHBPLPT,,DT,"A")
+13 ;I '$$ANYACTP^AMHAPRB(AMHBPLPT),AMHSX S AMHLINE=AMHLINE+1,^TMP($J,"AMHBPL",AMHLINE,0)="No Active BH Problems: "_$$FMTE^XLFDT($P(AMHSX,U,1))_" Documented By: "_$E($P($G(^VA(200,+$P(AMHSX,U,3),0)),U),1,25)
+14 IF AMHSX
SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)="No Active BH Problems Documented On: "_$$FMTE^XLFDT($PIECE(AMHSX,U,1))_" By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(AMHSX,U,3),0)),U),1,25)
+15 SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)=" "
+16 SET AMHPRCNT=0
+17 SET AMHAF="A"
DO GATHER1
SET AMHAF="I"
DO GATHER1
+18 QUIT
GATHER1 ;
+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
SET AMHP0=^AMHPPROB(AMHPIEN,0)
+4 IF AMHAF'=$PIECE(^AMHPPROB(AMHPIEN,0),U,12)
QUIT
+5 ;quit if not meet UU
+6 ;Q:'$$ALLOWV^AMHUTIL(DUZ,$P(^AMHPPROB(AMHPIEN,0),U,6)) no UU per Wendy
+7 SET AMHPRCNT=AMHPRCNT+1
SET AMHLINE=AMHLINE+1
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
SET AMHX=""
+8 SET AMHX=AMHPRCNT
SET AMHX=AMHX_") "
SET $EXTRACT(AMHX,6)="DX: "_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.01)
SET $EXTRACT(AMHX,20)="Status: "_IOUON_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.12)_IOUOFF
SET $EXTRACT(AMHX,50)="Last Modified: "_$$DATE^AMHVRL($PIECE(AMHP0,U,3))
+9 SET AMHBHPL(AMHLINE,0)=AMHX
SET AMHX=""
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
+10 SET AMHLINE=AMHLINE+1
+11 SET $EXTRACT(AMHX,6)="DSM Narrative: "_$$VAL^XBDIQ1(9002012.2,$PIECE(AMHP0,U,1),.02)
+12 SET AMHBHPL(AMHLINE,0)=AMHX
SET AMHX=""
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
+13 SET AMHLINE=AMHLINE+1
+14 SET $EXTRACT(AMHX,6)="Provider Narrative: "_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.05)
+15 SET AMHBHPL(AMHLINE,0)=AMHX
SET AMHX=""
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
+16 SET AMHLINE=AMHLINE+1
+17 SET $EXTRACT(AMHX,6)="Date of Onset: "_$$DATE^AMHVRL($PIECE(AMHP0,U,13))_" Facility: "_$$VAL^XBDIQ1(9002011.51,AMHPIEN,.06)
+18 SET AMHBHPL(AMHLINE,0)=AMHX
SET AMHX=""
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
NOTE ;
+1 IF '$DATA(^AMHPTP("AE",AMHPIEN))
Begin DoDot:3
+2 SET AMHLINE=AMHLINE+1
+3 SET AMHX=""
+4 SET AMHBHPL(AMHLINE,0)=AMHX
SET AMHX=""
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
End DoDot:3
QUIT
+5 SET AMHC=0
SET AMHTNDF=0
FOR
SET AMHTNDF=$ORDER(^AMHPTP("AE",AMHPIEN,AMHTNDF))
IF 'AMHTNDF
QUIT
Begin DoDot:3
+6 SET AMHNIEN=0
FOR
SET AMHNIEN=$ORDER(^AMHPTP("AE",AMHPIEN,AMHTNDF,AMHNIEN))
IF AMHNIEN'=+AMHNIEN
QUIT
Begin DoDot:4
+7 SET AMHC=AMHC+1
IF AMHC=1
SET X=IOINORM_" "_IORVON_"Notes:"_IORVOFF
SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)=X
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
+8 SET AMHLR=$$VALI^XBDIQ1(9002011.53,AMHNIEN,.07)
SET AMHLR=$SELECT(AMHLR=1:"STP",AMHLR=2:"LTP",1:" ")
+9 SET X=" "_AMHLR_" Note #"_AMHC_" Added: "_$SELECT($PIECE(^AMHPTP(AMHNIEN,0),U,5)]"":$$FMTE^XLFDT($PIECE(^(0),U,5),5),1:" ")
+10 SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)=X
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
+11 SET X=" Narrative: "_$PIECE(^AMHPTP(AMHNIEN,0),U,4)
End DoDot:4
+12 SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)=X
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
End DoDot:3
+13 SET AMHLINE=AMHLINE+1
SET AMHBHPL(AMHLINE,0)=IOINORM_" "
SET AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
+14 ;S AMHLINE=AMHLINE+1
+15 ;S AMHX=""
+16 ;S AMHBHPL(AMHLINE,0)=AMHX,AMHX="",AMHBHPL("IDX",AMHLINE,AMHPRCNT)=AMHPIEN
End DoDot:2
+17 QUIT
End DoDot:1
+18 KILL AMHLR,AMHL,AMHX,AMHF
+19 QUIT
TEXT ;
+1 ;;
+2 ;;*****************************************************
+3 ;;* Update Behavioral Health/PCC Patient Problem List *
+4 ;;*****************************************************
+5 ;;
+6 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL AMHBHPL
+2 KILL AMHPRCNT,AMHBPL,AMHLINE,AMHX,AMHP0,AMHC,AMHL,AMHLR,AMHPIEN,AMHAF,AMHPRB,AMHOVRR,AMHLOOK,AMHPDFN,AMHLOC,AMHDATE
+3 KILL X,Y
+4 KILL VALMHDR
+5 QUIT
+6 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
ANYNONUU(P,R) ;EP - any problem that is allowed to be seen?
+1 NEW G,A,B,C
+2 IF '$GET(P)
QUIT ""
+3 IF '$GET(R)
QUIT ""
+4 SET G=0
+5 SET A=0
FOR
SET A=$ORDER(^AMHPPROB("AC",P,A))
IF A'=+A!(G)
QUIT
Begin DoDot:1
+6 ;deleted
IF $PIECE(^AMHPPROB(A,0),U,12)="D"
QUIT Q
+7 SET B=$PIECE(^AMHPPROB(A,0),U,6)
+8 IF '$$ALLOWV^AMHUTIL(R,B)
QUIT
+9 SET G=1
End DoDot:1
+10 QUIT G
