- 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
