AMHRPTST ; IHS/CMI/LAB - PROCESS REPORT ;
;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
;
SETTMP2 ;EP
UTL ;
D PROBPROC
Q
;
SET F AMHPOV=0:0 S AMHPOV=$O(@AMHA) Q:'AMHPOV S %=^(AMHPOV),@AMHC@(9999999-%,AMHPOV)=""
Q
SETTMP1 ;EP ; SET TMP FOR PROGRAM ACTIVITY REPORT
D XTMP^AMHUTIL("AMHRAT2","BH RPOGRAM REPORT")
S AMHPRIM="P"
S (AMHCOUNT,AMHPPOV)="" F S AMHPPOV=$O(^AMHRPRO("AD",AMHR,AMHPPOV)) Q:AMHPPOV'=+AMHPPOV!(AMHCOUNT>0&(AMHPRIM="P")) S AMHCOUNT=AMHCOUNT+1 D @AMHRPROC,SETTMP11
Q
SETTMP11 ;
S ^("REC TOTAL")=$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$P(AMHR0,U,2),"REC TOTAL")):^("REC TOTAL")+1,1:1)
S ^("REC TOTAL")=$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,"C","REC TOTAL")):^("REC TOTAL")+1,1:1)
S ^("TIME TOTAL")=$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$P(AMHR0,U,2),"TIME TOTAL")):^("TIME TOTAL")+($P(AMHR0,U,12)),1:$P(AMHR0,U,12))
S ^("TIME TOTAL")=$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,"C","TIME TOTAL")):^("TIME TOTAL")+($P(AMHR0,U,12)),1:$P(AMHR0,U,12))
Q:$P(AMHR0,U,8)=""
Q:$D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$P(AMHR0,U,2),"PATS",$P(AMHR0,U,8),@AMHSORT))
S ^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$P(AMHR0,U,2),"PATS",$P(AMHR0,U,8),@AMHSORT)=""
S ^("PATIENT TOTAL")=$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$P(AMHR0,U,2),"PATIENT TOTAL")):^("PATIENT TOTAL")+1,1:1)
S ^("PATIENT TOTAL")=$S($D(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,"C","PATIENT TOTAL")):^("PATIENT TOTAL")+1,1:1)
Q
;
SETTMP ;EP - CALLED FROM AMHPT4
D XTMP^AMHUTIL("AMHRAP2","BH ACTIVITY COUNTS")
S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
D @AMHRPROC
S ^(AMHSRT2)=$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",@AMHSORT,AMHSRT2)):^(AMHSRT2)+1,1:1)
S ^(AMHSRT2)=$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",@AMHSORT,AMHSRT2)):^(AMHSRT2)+$P(AMHR0,U,12),1:$P(AMHR0,U,12))
S ^(AMHSRT2)=$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",@AMHSORT,AMHSRT2)):^(AMHSRT2)+$P(AMHR0,U,9),1:$P(AMHR0,U,9))
Q:$P(AMHR0,U,8)=""
Q:$D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATS",$P(AMHR0,U,8),@AMHSORT))
S ^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATS",$P(AMHR0,U,8),@AMHSORT)=""
S ^(AMHSRT2)=$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",@AMHSORT,AMHSRT2)):^(AMHSRT2)+1,1:1)
Q
PROG ;
S AMHPROG=$P(AMHR0,U,2) I AMHPROG="" S AMHPROG="NO PROGRAM ENTERED",AMHSRT2="--" Q
S AMHSRT2=$P(AMHR0,U,2),AMHPROG=$S($P(AMHR0,U,2)="M":"MENTAL HEALTH",$P(AMHR0,U,2)="S":"SOCIAL SERVICES",$P(AMHR0,U,2)="C":"CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE",$P(AMHR0,U,2)="O":"OTHER",1:"NO PROGRAM ENTERED")
Q
;
APWI ;
S AMHAPWI=$P(AMHR0,U,11) I AMHAPWI="" S AMHAPWI="NO APPT/WALK-IN RECORDED",AMHSRT2="--" Q
S AMHSRT2=$P(AMHR0,U,11),AMHAPWI=$S($P(AMHR0,U,11)="A":"APPOINTMENT",$P(AMHR0,U,11)="W":"WALK-IN",$P(AMHR0,U,11)="U":"UNSPECIFIED",1:"NO PROGRAM ENTERED")
Q
;
INT ;
S AMHINTR=$P(AMHR0,U,15) I AMHINTR="" S AMHINTR="NOT RECORDED",AMHSRT2="--" Q
S AMHSRT2=$P(AMHR0,U,15),AMHINTR=$S($P(AMHR0,U,15)=1:"YES, INTERPRETOR UTILIZED",1:"INTERPRETOR NOT UTILIZED")
Q
TOC ;
S AMHCAT=$P(^AMHTSET($P(AMHR0,U,7),0),U)
S AMHSRT2=$P(^AMHTSET($P(AMHR0,U,7),0),U,2)
K ^UTILITY("DIQ1",$J)
Q
DATE ;
S AMHDATE=$P(AMHODAT,".")
S X=AMHDATE D H^%DTC S AMHSRT2=$P("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1) I AMHSRT2="" S AMHSRT2="UNKNOWN"
Q
DISC ;
S AMHDISC=$E($$PPCLS^AMHUTIL(AMHR,"E"),1,25),AMHSRT2=$$PPCLSC^AMHUTIL(AMHR)
Q
PROV ;
S AMHPROV=$$PPNAME^AMHUTIL(AMHR),AMHSRT2=$E($$PPCLS^AMHUTIL(AMHR,"E"),1,20)
Q
COMM ;
S AMHCOMM=$P(^AUTTCOM($P(AMHR0,U,5),0),U),AMHSRT2=$P(^(0),U,8)
Q
ACTC ;
K ^UTILITY("DIQ1",$J)
K DIQ,DIC,DA,DR
S DIC="^AMHTACT(",DR=".03",DA=$P(AMHR0,U,6),DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
S AMHACTC=^UTILITY("DIQ1",$J,9002012,$P(AMHR0,U,6),.03,"E")
S AMHSRT2=$P(^AMHTACT($P(AMHR0,U,6),0),U,3)
K ^UTILITY("DIQ1",$J)
Q
ACT ;
S AMHACT=$E($P(^AMHTACT($P(AMHR0,U,6),0),U,2),1,60),AMHSRT2=$P(^AMHTACT($P(AMHR0,U,6),0),U)
Q
SU ;
S AMHSU=$P(^AUTTLOC($P(AMHR0,U,4),0),U,5) I AMHSU="" S AMHSU="NONE ENTERED",AMHSRT2="9999" Q
S AMHSRT2=$P(^AUTTSU(AMHSU,0),U,4),AMHSU=$P(^AUTTSU(AMHSU,0),U)
Q
AGE ;
I $P(AMHR0,U,8)="" S AMHAGE="--",AMHSRT2="--" Q
S AMHAGE=$$AGE^AUPNPAT($P(AMHR0,U,8),$P($P(AMHR0,U),".")),AMHSRT2="--"
Q
GENDER ;
I $P(AMHR0,U,8)="" S AMHSEX="--",AMHSRT2="--" Q
S AMHSRT2=$P(^DPT($P(AMHR0,U,8),0),U,2),AMHSEX=$S(AMHSRT2="F":"FEMALE",AMHSRT2="M":"MALE",1:"UNKNOWN")
Q
CLN ;
S AMHCLN=$P(AMHR0,U,25)
I AMHCLN S AMHSRT2=$P(^DIC(40.7,AMHCLN,0),U,2),AMHCLN=$P(^DIC(40.7,AMHCLN,0),U)
I AMHCLN="" S AMHCLN="<none entered>",AMHSRT2="--"
I $G(AMHSRT2)="" S AMHSRT2="--"
Q
LSS ;
S AMHLSS=$P(AMHR0,U,31)
I AMHLSS S AMHSRT2=$P(^AMHLSS(AMHLSS,0),U,2),AMHLSS=$P(^AMHLSS(AMHLSS,0),U)
I AMHLSS="" S AMHLSS="<none entered>"
I $G(AMHSRT2)="" S AMHSRT2="--"
Q
LOS ;
S AMHVLOC=$P(^DIC(4,$P(AMHR0,U,4),0),U),AMHSRT2=$P(^AUTTLOC($P(AMHR0,U,4),0),U,10)
Q
;
PROBPROC ;
I AMHRRPT="A"!(AMHRRPT="AC") S AMHPPOV=$O(^AMHRPRO("AD",AMHR,0)) D @AMHRPROC,SETTMP21 Q
S (AMHCOUNT,AMHPPOV)="" F S AMHPPOV=$O(^AMHRPRO("AD",AMHR,AMHPPOV)) Q:AMHPPOV'=+AMHPPOV!(AMHCOUNT>0&(AMHPRIM="P")) S AMHCOUNT=AMHCOUNT+1 D @AMHRPROC,SETTMP21
Q
SETTMP21 ;
S X=AMHA
S AMHPOV=@AMHSORT
I '$D(@X) S @X=0
S AMHTACT=$P(^AMHREC(AMHR,0),U,12)
S %=+(@X),%=%+1,%1=$P((@X),U,3),%1=%1+AMHTACT,@X=%_"^"_AMHSRT2_"^"_%1
K %,%1
Q
PROB ;
;S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
I AMHPPOV="" S AMHPROB="NO PROBLEMS/POVS ENTERED",AMHSRT2="---" Q
S AMHPROB=$P(^AMHRPRO(AMHPPOV,0),U),AMHPROB=$P(^AMHPROB(AMHPROB,0),U,3),AMHPROB=$E($P(^AMHPROBC(AMHPROB,0),U,2),1,60)
S AMHSRT2=$P(^AMHRPRO(AMHPPOV,0),U),AMHSRT2=$P(^AMHPROB(AMHSRT2,0),U,3),AMHSRT2=$P(^AMHPROBC(AMHSRT2,0),U)
Q
PROBD ;
;S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
I AMHPPOV="" S AMHPROB="NO PROBLEMS/POVS ENTERED",AMHSRT2="---" Q
S AMHSRT2=$P(^AMHPROB($P(^AMHRPRO(AMHPPOV,0),U),0),U)
S AMHPROB=$E($P(^AMHPROB($P(^AMHRPRO(AMHPPOV,0),U),0),U,2),1,60)
Q
PROBCAT ;
;S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
I AMHPPOV="" S AMHPROB="NO PROBLEMS/POVS ENTERED",AMHSRT2="---" Q
S AMHSRT2=$P(^AMHPROB($P(^AMHRPRO(AMHPPOV,0),U),0),U,3),AMHSRT2=$P(^AMHPROBC(AMHSRT2,0),U,3)
S AMHPROB=$E($P(^AMHPCAT(AMHSRT2,0),U),1,60)
Q
AMHRPTST ; IHS/CMI/LAB - PROCESS REPORT ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
+2 ;
SETTMP2 ;EP
UTL ;
+1 DO PROBPROC
+2 QUIT
+3 ;
SET FOR AMHPOV=0:0
SET AMHPOV=$ORDER(@AMHA)
IF 'AMHPOV
QUIT
SET %=^(AMHPOV)
SET @AMHC@(9999999-%,AMHPOV)=""
+1 QUIT
SETTMP1 ;EP ; SET TMP FOR PROGRAM ACTIVITY REPORT
+1 DO XTMP^AMHUTIL("AMHRAT2","BH RPOGRAM REPORT")
+2 SET AMHPRIM="P"
+3 SET (AMHCOUNT,AMHPPOV)=""
FOR
SET AMHPPOV=$ORDER(^AMHRPRO("AD",AMHR,AMHPPOV))
IF AMHPPOV'=+AMHPPOV!(AMHCOUNT>0&(AMHPRIM="P"))
QUIT
SET AMHCOUNT=AMHCOUNT+1
DO @AMHRPROC
DO SETTMP11
+4 QUIT
SETTMP11 ;
+1 SET ^("REC TOTAL")=$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$PIECE(AMHR0,U,2),"REC TOTAL")):^("REC TOTAL")+1,1:1)
+2 SET ^("REC TOTAL")=$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,"C","REC TOTAL")):^("REC TOTAL")+1,1:1)
+3 SET ^("TIME TOTAL")=$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$PIECE(AMHR0,U,2),"TIME TOTAL")):^("TIME TOTAL")+($PIECE(AMHR0,U,12)),1:$PIECE(AMHR0,U,12))
+4 SET ^("TIME TOTAL")=$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,"C","TIME TOTAL")):^("TIME TOTAL")+($PIECE(AMHR0,U,12)),1:$PIECE(AMHR0,U,12))
+5 IF $PIECE(AMHR0,U,8)=""
QUIT
+6 IF $DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$PIECE(AMHR0,U,2),"PATS",$PIECE(AMHR0,U,8),@AMHSORT))
QUIT
+7 SET ^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$PIECE(AMHR0,U,2),"PATS",$PIECE(AMHR0,U,8),@AMHSORT)=""
+8 SET ^("PATIENT TOTAL")=$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,$PIECE(AMHR0,U,2),"PATIENT TOTAL")):^("PATIENT TOTAL")+1,1:1)
+9 SET ^("PATIENT TOTAL")=$SELECT($DATA(^XTMP("AMHRAT2",AMHJOB,AMHBTH,@AMHSORT,"C","PATIENT TOTAL")):^("PATIENT TOTAL")+1,1:1)
+10 QUIT
+11 ;
SETTMP ;EP - CALLED FROM AMHPT4
+1 DO XTMP^AMHUTIL("AMHRAP2","BH ACTIVITY COUNTS")
+2 SET AMHPPOV=$ORDER(^AMHRPRO("AD",AMHR,""))
+3 DO @AMHRPROC
+4 SET ^(AMHSRT2)=$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",@AMHSORT,AMHSRT2)):^(AMHSRT2)+1,1:1)
+5 SET ^(AMHSRT2)=$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",@AMHSORT,AMHSRT2)):^(AMHSRT2)+$PIECE(AMHR0,U,12),1:$PIECE(AMHR0,U,12))
+6 SET ^(AMHSRT2)=$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",@AMHSORT,AMHSRT2)):^(AMHSRT2)+$PIECE(AMHR0,U,9),1:$PIECE(AMHR0,U,9))
+7 IF $PIECE(AMHR0,U,8)=""
QUIT
+8 IF $DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATS",$PIECE(AMHR0,U,8),@AMHSORT))
QUIT
+9 SET ^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATS",$PIECE(AMHR0,U,8),@AMHSORT)=""
+10 SET ^(AMHSRT2)=$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",@AMHSORT,AMHSRT2)):^(AMHSRT2)+1,1:1)
+11 QUIT
PROG ;
+1 SET AMHPROG=$PIECE(AMHR0,U,2)
IF AMHPROG=""
SET AMHPROG="NO PROGRAM ENTERED"
SET AMHSRT2="--"
QUIT
+2 SET AMHSRT2=$PIECE(AMHR0,U,2)
SET AMHPROG=$SELECT($PIECE(AMHR0,U,2)="M":"MENTAL HEALTH",$PIECE(AMHR0,U,2)="S":"SOCIAL SERVICES",$PIECE(AMHR0,U,2)="C":"CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE",$PIECE(AMHR0,U,2)="O":"OTHER",1:"NO PROGRAM ENTERED")
+3 QUIT
+4 ;
APWI ;
+1 SET AMHAPWI=$PIECE(AMHR0,U,11)
IF AMHAPWI=""
SET AMHAPWI="NO APPT/WALK-IN RECORDED"
SET AMHSRT2="--"
QUIT
+2 SET AMHSRT2=$PIECE(AMHR0,U,11)
SET AMHAPWI=$SELECT($PIECE(AMHR0,U,11)="A":"APPOINTMENT",$PIECE(AMHR0,U,11)="W":"WALK-IN",$PIECE(AMHR0,U,11)="U":"UNSPECIFIED",1:"NO PROGRAM ENTERED")
+3 QUIT
+4 ;
INT ;
+1 SET AMHINTR=$PIECE(AMHR0,U,15)
IF AMHINTR=""
SET AMHINTR="NOT RECORDED"
SET AMHSRT2="--"
QUIT
+2 SET AMHSRT2=$PIECE(AMHR0,U,15)
SET AMHINTR=$SELECT($PIECE(AMHR0,U,15)=1:"YES, INTERPRETOR UTILIZED",1:"INTERPRETOR NOT UTILIZED")
+3 QUIT
TOC ;
+1 SET AMHCAT=$PIECE(^AMHTSET($PIECE(AMHR0,U,7),0),U)
+2 SET AMHSRT2=$PIECE(^AMHTSET($PIECE(AMHR0,U,7),0),U,2)
+3 KILL ^UTILITY("DIQ1",$JOB)
+4 QUIT
DATE ;
+1 SET AMHDATE=$PIECE(AMHODAT,".")
+2 SET X=AMHDATE
DO H^%DTC
SET AMHSRT2=$PIECE("SUNDAY;MONDAY;TUESDAY;WEDNESDAY;THURSDAY;FRIDAY;SATURDAY",";",%Y+1)
IF AMHSRT2=""
SET AMHSRT2="UNKNOWN"
+3 QUIT
DISC ;
+1 SET AMHDISC=$EXTRACT($$PPCLS^AMHUTIL(AMHR,"E"),1,25)
SET AMHSRT2=$$PPCLSC^AMHUTIL(AMHR)
+2 QUIT
PROV ;
+1 SET AMHPROV=$$PPNAME^AMHUTIL(AMHR)
SET AMHSRT2=$EXTRACT($$PPCLS^AMHUTIL(AMHR,"E"),1,20)
+2 QUIT
COMM ;
+1 SET AMHCOMM=$PIECE(^AUTTCOM($PIECE(AMHR0,U,5),0),U)
SET AMHSRT2=$PIECE(^(0),U,8)
+2 QUIT
ACTC ;
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL DIQ,DIC,DA,DR
+3 SET DIC="^AMHTACT("
SET DR=".03"
SET DA=$PIECE(AMHR0,U,6)
SET DIQ(0)="E"
DO EN^DIQ1
KILL DIC,DA,DR,DIQ
+4 SET AMHACTC=^UTILITY("DIQ1",$JOB,9002012,$PIECE(AMHR0,U,6),.03,"E")
+5 SET AMHSRT2=$PIECE(^AMHTACT($PIECE(AMHR0,U,6),0),U,3)
+6 KILL ^UTILITY("DIQ1",$JOB)
+7 QUIT
ACT ;
+1 SET AMHACT=$EXTRACT($PIECE(^AMHTACT($PIECE(AMHR0,U,6),0),U,2),1,60)
SET AMHSRT2=$PIECE(^AMHTACT($PIECE(AMHR0,U,6),0),U)
+2 QUIT
SU ;
+1 SET AMHSU=$PIECE(^AUTTLOC($PIECE(AMHR0,U,4),0),U,5)
IF AMHSU=""
SET AMHSU="NONE ENTERED"
SET AMHSRT2="9999"
QUIT
+2 SET AMHSRT2=$PIECE(^AUTTSU(AMHSU,0),U,4)
SET AMHSU=$PIECE(^AUTTSU(AMHSU,0),U)
+3 QUIT
AGE ;
+1 IF $PIECE(AMHR0,U,8)=""
SET AMHAGE="--"
SET AMHSRT2="--"
QUIT
+2 SET AMHAGE=$$AGE^AUPNPAT($PIECE(AMHR0,U,8),$PIECE($PIECE(AMHR0,U),"."))
SET AMHSRT2="--"
+3 QUIT
GENDER ;
+1 IF $PIECE(AMHR0,U,8)=""
SET AMHSEX="--"
SET AMHSRT2="--"
QUIT
+2 SET AMHSRT2=$PIECE(^DPT($PIECE(AMHR0,U,8),0),U,2)
SET AMHSEX=$SELECT(AMHSRT2="F":"FEMALE",AMHSRT2="M":"MALE",1:"UNKNOWN")
+3 QUIT
CLN ;
+1 SET AMHCLN=$PIECE(AMHR0,U,25)
+2 IF AMHCLN
SET AMHSRT2=$PIECE(^DIC(40.7,AMHCLN,0),U,2)
SET AMHCLN=$PIECE(^DIC(40.7,AMHCLN,0),U)
+3 IF AMHCLN=""
SET AMHCLN="<none entered>"
SET AMHSRT2="--"
+4 IF $GET(AMHSRT2)=""
SET AMHSRT2="--"
+5 QUIT
LSS ;
+1 SET AMHLSS=$PIECE(AMHR0,U,31)
+2 IF AMHLSS
SET AMHSRT2=$PIECE(^AMHLSS(AMHLSS,0),U,2)
SET AMHLSS=$PIECE(^AMHLSS(AMHLSS,0),U)
+3 IF AMHLSS=""
SET AMHLSS="<none entered>"
+4 IF $GET(AMHSRT2)=""
SET AMHSRT2="--"
+5 QUIT
LOS ;
+1 SET AMHVLOC=$PIECE(^DIC(4,$PIECE(AMHR0,U,4),0),U)
SET AMHSRT2=$PIECE(^AUTTLOC($PIECE(AMHR0,U,4),0),U,10)
+2 QUIT
+3 ;
PROBPROC ;
+1 IF AMHRRPT="A"!(AMHRRPT="AC")
SET AMHPPOV=$ORDER(^AMHRPRO("AD",AMHR,0))
DO @AMHRPROC
DO SETTMP21
QUIT
+2 SET (AMHCOUNT,AMHPPOV)=""
FOR
SET AMHPPOV=$ORDER(^AMHRPRO("AD",AMHR,AMHPPOV))
IF AMHPPOV'=+AMHPPOV!(AMHCOUNT>0&(AMHPRIM="P"))
QUIT
SET AMHCOUNT=AMHCOUNT+1
DO @AMHRPROC
DO SETTMP21
+3 QUIT
SETTMP21 ;
+1 SET X=AMHA
+2 SET AMHPOV=@AMHSORT
+3 IF '$DATA(@X)
SET @X=0
+4 SET AMHTACT=$PIECE(^AMHREC(AMHR,0),U,12)
+5 SET %=+(@X)
SET %=%+1
SET %1=$PIECE((@X),U,3)
SET %1=%1+AMHTACT
SET @X=%_"^"_AMHSRT2_"^"_%1
+6 KILL %,%1
+7 QUIT
PROB ;
+1 ;S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
+2 IF AMHPPOV=""
SET AMHPROB="NO PROBLEMS/POVS ENTERED"
SET AMHSRT2="---"
QUIT
+3 SET AMHPROB=$PIECE(^AMHRPRO(AMHPPOV,0),U)
SET AMHPROB=$PIECE(^AMHPROB(AMHPROB,0),U,3)
SET AMHPROB=$EXTRACT($PIECE(^AMHPROBC(AMHPROB,0),U,2),1,60)
+4 SET AMHSRT2=$PIECE(^AMHRPRO(AMHPPOV,0),U)
SET AMHSRT2=$PIECE(^AMHPROB(AMHSRT2,0),U,3)
SET AMHSRT2=$PIECE(^AMHPROBC(AMHSRT2,0),U)
+5 QUIT
PROBD ;
+1 ;S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
+2 IF AMHPPOV=""
SET AMHPROB="NO PROBLEMS/POVS ENTERED"
SET AMHSRT2="---"
QUIT
+3 SET AMHSRT2=$PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHPPOV,0),U),0),U)
+4 SET AMHPROB=$EXTRACT($PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHPPOV,0),U),0),U,2),1,60)
+5 QUIT
PROBCAT ;
+1 ;S AMHPPOV=$O(^AMHRPRO("AD",AMHR,""))
+2 IF AMHPPOV=""
SET AMHPROB="NO PROBLEMS/POVS ENTERED"
SET AMHSRT2="---"
QUIT
+3 SET AMHSRT2=$PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHPPOV,0),U),0),U,3)
SET AMHSRT2=$PIECE(^AMHPROBC(AMHSRT2,0),U,3)
+4 SET AMHPROB=$EXTRACT($PIECE(^AMHPCAT(AMHSRT2,0),U),1,60)
+5 QUIT
