- APCLIPC3 ; IHS/OHPRD/TMJ - continuation of APCLIPC2 ; [ 03/19/01 9:47 AM ]
- ;;3.0;IHS PCC REPORTS;**7**;FEB 05, 1997
- VISITS ;
- K APCLGOTA,APCLGOTB,APCLSKIP,APCLLOCC
- S APCLV=0 F S APCLV=$O(^AUPNVSIT("AA",APCLDFN,APCLV)) Q:APCLV'=+APCLV!($D(APCLGOTA)&($D(APCLGOTB)))!($P(APCLV,".")>APCLSDI) S APCLVD=$P(APCLV,".") D PROC
- Q
- PROC ;
- S APCLVDFN=0 F S APCLVDFN=$O(^AUPNVSIT("AA",APCLDFN,APCLV,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN S APCLVREC=^AUPNVSIT(APCLVDFN,0) D SEEN
- Q
- SEEN ;determine if patient was seen in FYs
- K APCLSKIP
- G:$D(APCLGOTA) ALL
- Q:APCLVD>APCLSDI
- Q:APCLVD<APCLEDI
- I APCLVFL="L",APCLSU'=$P(APCLVREC,U,6) Q
- Q:$P(APCLVREC,U,7)'="H" ;Quit if Not Inpatient
- Q:$P(APCLVREC,U,11)
- Q:'$P(APCLVREC,U,9)
- S APCLGOTA="",$P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,2)=$P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,2)+1
- ALL ;
- Q:$D(APCLGOTB)
- Q:$P(APCLVREC,U,7)'="H" ;Quit if Not Inpatient
- I APCLVFL="L",APCLSU'=$P(APCLVREC,U,6) Q
- Q:$P(APCLVREC,U,11)
- Q:'$P(APCLVREC,U,9)
- I APCLVD>APCLSDI S APCLGOTB="" Q
- Q:APCLVD<APCLEDI
- S $P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,3)=$P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,3)+1
- APC ;
- Q:$P(APCLVREC,U,7)'="H" ;Quit if not Inpatient
- Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))
- Q:'$D(^AUPNVPOV("AD",APCLVDFN))
- Q:'$D(^AUPNVPRV("AD",APCLVDFN))
- S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""
- Q:'$D(^DIC(4,APCLVLOC))
- Q:'$D(^AUTTLOC(APCLVLOC))
- S APCLCLIN=$P(APCLVREC,U,8) I APCLCLIN="" G PCP
- CHKCL ;
- S X=$S(APCLCLIN="":"",$D(^DIC(40.7,APCLCLIN,0)):$P(^DIC(40.7,APCLCLIN,0),U,2),1:"")
- Q:X=""
- I X=56,'$D(^AUPNVMED("AD",APCLVDFN)) Q
- I $D(^APCLCNTL(2,11,"B",X)) Q
- PCP ;
- S (APCL1,APCL2)=0 F I=0:0 S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2="" I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1,APCLAP=$P(^(0),U)
- I APCL1=0 Q
- I APCL1>1 Q
- S APCLDISC="" D DISC
- Q:$D(APCLSKIP)
- S APCLPPOV=$O(^AUPNVPOV("AD",APCLVDFN,""))
- Q:$P(^ICD9($P(^AUPNVPOV(APCLPPOV,0),U),0),U)=".9999"
- S $P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,4)=$P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,4)+1
- I APCLDISC>69,APCLDISC<91,APCLDISC'=88 G PCP1
- S X="P"_APCLDISC I $T(@X)="" Q
- PCP1 S $P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,5)=$P(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,5)+1
- Q
- DISC ;
- I $P(^DD(9000010.06,.01,0),U,2)[6 G DISC6
- S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)
- I APCLDISC'?.N S APCLSKIP="" Q
- S APCLLOCC=$E($P(^AUTTLOC(APCLVLOC,0),U,10),5,6)
- I (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC)) S APCLSKIP=1
- Q
- DISC6 ;
- I '$D(^DIC(6,APCLAP)) S APCLSKIP="" Q
- S APCLY=$P(^DIC(6,APCLAP,0),U,4)
- I APCLY="" S APCLSKIP="" Q
- I '$D(^DIC(7,APCLY,9999999)) S APCLSKIP="" Q
- S APCLDISC=$P(^DIC(7,APCLY,9999999),U) I APCLDISC="" S APCLSKIP="" Q
- S APCLLOCC=$E($P(^AUTTLOC(APCLVLOC,0),U,10),5,6)
- I (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC)) S APCLSKIP=1
- Q
- P00 ;;
- P11 ;;
- P16 ;;
- P17 ;;
- P18 ;;
- P21 ;;
- P41 ;;
- P44 ;;
- P25 ;;
- P33 ;;
- APCLIPC3 ; IHS/OHPRD/TMJ - continuation of APCLIPC2 ; [ 03/19/01 9:47 AM ]
- +1 ;;3.0;IHS PCC REPORTS;**7**;FEB 05, 1997
- VISITS ;
- +1 KILL APCLGOTA,APCLGOTB,APCLSKIP,APCLLOCC
- +2 SET APCLV=0
- FOR
- SET APCLV=$ORDER(^AUPNVSIT("AA",APCLDFN,APCLV))
- IF APCLV'=+APCLV!($DATA(APCLGOTA)&($DATA(APCLGOTB)))!($PIECE(APCLV,".")>APCLSDI)
- QUIT
- SET APCLVD=$PIECE(APCLV,".")
- DO PROC
- +3 QUIT
- PROC ;
- +1 SET APCLVDFN=0
- FOR
- SET APCLVDFN=$ORDER(^AUPNVSIT("AA",APCLDFN,APCLV,APCLVDFN))
- IF APCLVDFN'=+APCLVDFN
- QUIT
- SET APCLVREC=^AUPNVSIT(APCLVDFN,0)
- DO SEEN
- +2 QUIT
- SEEN ;determine if patient was seen in FYs
- +1 KILL APCLSKIP
- +2 IF $DATA(APCLGOTA)
- GOTO ALL
- +3 IF APCLVD>APCLSDI
- QUIT
- +4 IF APCLVD<APCLEDI
- QUIT
- +5 IF APCLVFL="L"
- IF APCLSU'=$PIECE(APCLVREC,U,6)
- QUIT
- +6 ;Quit if Not Inpatient
- IF $PIECE(APCLVREC,U,7)'="H"
- QUIT
- +7 IF $PIECE(APCLVREC,U,11)
- QUIT
- +8 IF '$PIECE(APCLVREC,U,9)
- QUIT
- +9 SET APCLGOTA=""
- SET $PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,2)=$PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,2)+1
- ALL ;
- +1 IF $DATA(APCLGOTB)
- QUIT
- +2 ;Quit if Not Inpatient
- IF $PIECE(APCLVREC,U,7)'="H"
- QUIT
- +3 IF APCLVFL="L"
- IF APCLSU'=$PIECE(APCLVREC,U,6)
- QUIT
- +4 IF $PIECE(APCLVREC,U,11)
- QUIT
- +5 IF '$PIECE(APCLVREC,U,9)
- QUIT
- +6 IF APCLVD>APCLSDI
- SET APCLGOTB=""
- QUIT
- +7 IF APCLVD<APCLEDI
- QUIT
- +8 SET $PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,3)=$PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,3)+1
- APC ;
- +1 ;Quit if not Inpatient
- IF $PIECE(APCLVREC,U,7)'="H"
- QUIT
- +2 IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))
- QUIT
- +3 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
- QUIT
- +4 IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
- QUIT
- +5 SET APCLVLOC=$PIECE(APCLVREC,U,6)
- IF APCLVLOC=""
- QUIT
- +6 IF '$DATA(^DIC(4,APCLVLOC))
- QUIT
- +7 IF '$DATA(^AUTTLOC(APCLVLOC))
- QUIT
- +8 SET APCLCLIN=$PIECE(APCLVREC,U,8)
- IF APCLCLIN=""
- GOTO PCP
- CHKCL ;
- +1 SET X=$SELECT(APCLCLIN="":"",$DATA(^DIC(40.7,APCLCLIN,0)):$PIECE(^DIC(40.7,APCLCLIN,0),U,2),1:"")
- +2 IF X=""
- QUIT
- +3 IF X=56
- IF '$DATA(^AUPNVMED("AD",APCLVDFN))
- QUIT
- +4 IF $DATA(^APCLCNTL(2,11,"B",X))
- QUIT
- PCP ;
- +1 SET (APCL1,APCL2)=0
- FOR I=0:0
- SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))
- IF APCL2=""
- QUIT
- IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"
- SET APCL1=APCL1+1
- SET APCLAP=$PIECE(^(0),U)
- +2 IF APCL1=0
- QUIT
- +3 IF APCL1>1
- QUIT
- +4 SET APCLDISC=""
- DO DISC
- +5 IF $DATA(APCLSKIP)
- QUIT
- +6 SET APCLPPOV=$ORDER(^AUPNVPOV("AD",APCLVDFN,""))
- +7 IF $PIECE(^ICD9($PIECE(^AUPNVPOV(APCLPPOV,0),U),0),U)=".9999"
- QUIT
- +8 SET $PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,4)=$PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,4)+1
- +9 IF APCLDISC>69
- IF APCLDISC<91
- IF APCLDISC'=88
- GOTO PCP1
- +10 SET X="P"_APCLDISC
- IF $TEXT(@X)=""
- QUIT
- PCP1 SET $PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,5)=$PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,@APCLMAJ,@APCLMIN),U,5)+1
- +1 QUIT
- DISC ;
- +1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
- GOTO DISC6
- +2 SET APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)
- +3 IF APCLDISC'?.N
- SET APCLSKIP=""
- QUIT
- +4 SET APCLLOCC=$EXTRACT($PIECE(^AUTTLOC(APCLVLOC,0),U,10),5,6)
- +5 IF (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC))
- SET APCLSKIP=1
- +6 QUIT
- DISC6 ;
- +1 IF '$DATA(^DIC(6,APCLAP))
- SET APCLSKIP=""
- QUIT
- +2 SET APCLY=$PIECE(^DIC(6,APCLAP,0),U,4)
- +3 IF APCLY=""
- SET APCLSKIP=""
- QUIT
- +4 IF '$DATA(^DIC(7,APCLY,9999999))
- SET APCLSKIP=""
- QUIT
- +5 SET APCLDISC=$PIECE(^DIC(7,APCLY,9999999),U)
- IF APCLDISC=""
- SET APCLSKIP=""
- QUIT
- +6 SET APCLLOCC=$EXTRACT($PIECE(^AUTTLOC(APCLVLOC,0),U,10),5,6)
- +7 IF (APCLDISC=13!(APCLDISC=32))&((APCLLOCC>49)!(APCLLOCC'=+APCLLOCC))
- SET APCLSKIP=1
- +8 QUIT
- P00 ;;
- P11 ;;
- P16 ;;
- P17 ;;
- P18 ;;
- P21 ;;
- P41 ;;
- P44 ;;
- P25 ;;
- P33 ;;
