APCLCP61 ; IHS/CMI/LAB - activity report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
S APCLJOB=$J,APCLBT=$H
D XTMP^APCLOSUT(APCLNSP,"PCC ACTIVITY REPORT")
V ; Run by visit date
S APCLODAT=$O(^AUPNVSIT("B",APCLSD)) I APCLODAT="" S APCLET=$H Q
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
S APCLET=$H
Q
V1 ;
S APCLVDFN=0 F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)) S APCLVREC=^(0) D PROC,EOJ
Q
PROC ;
K APCLSKIP
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:'$P(APCLVREC,U,9)
Q:$P(APCLVREC,U,11)
Q:"DXECH"[$P(APCLVREC,U,7)
Q:"V"[$P(APCLVREC,U,3)
I $D(APCLLOC) Q:$P(APCLVREC,U,6)="" I '$D(APCLLOC($P(APCLVREC,U,6))) Q
I $D(APCLCLN) Q:$P(APCLVREC,U,8)="" I '$D(APCLCLN($P(APCLVREC,U,8))) Q
Q:'$D(^AUPNVPOV("AD",APCLVDFN))
Q:'$D(^AUPNVPRV("AD",APCLVDFN))
S (APCL1,APCL2)=0 F L=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 APCLVLOC=$P(APCLVREC,U,6)
Q:APCLVLOC=""
S APCLSU=$P(^AUTTLOC(APCLVLOC,0),U,5) I APCLSU="" S APCLSU="ZZZZ"
D PROC2
Q
EOJ K APCLVLOC,APCLVREC,APCLSKIP,APCL1,APCL2,APCLX,APCLY,APCLAP,APCLDISC,APCLVLOC,APCLVTM,APCLVTT
Q
;
;
PROC2 ;
S APCLX=0 F S APCLX=$O(^AUPNVPRV("AD",APCLVDFN,APCLX)) Q:APCLX'=+APCLX D
. S APCLAP=$P(^AUPNVPRV(APCLX,0),U)
. I $P(^DD(9000010.06,.01,0),U,2)[200 S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP) Q:'$D(^APCLACTG(APCLACTG,11,"AC",APCLDISC)) G PROC21
. S APCLY=$P(^DIC(6,APCLAP,0),U,4)
. I APCLY="" Q
. I '$D(^DIC(7,APCLY,9999999)) Q
. S APCLDISC=$P(^DIC(7,APCLY,9999999),U) I '$D(^APCLACTG(APCLACTG,11,"AC",APCLDISC)) Q
PROC21 . I '$D(^XTMP(APCLNSP,APCLJOB,APCLBT,"PATIENT",$P(APCLVREC,U,5),@APCLSORV)) D
..S ^("TOTAL")=$S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,@APCLSORV,APCLVLOC,"TOTAL")):^("TOTAL")+1,1:1),^XTMP(APCLNSP,APCLJOB,APCLBT,"PATIENT",$P(APCLVREC,U,5),@APCLSORV)=""
Q
APCLCP61 ; IHS/CMI/LAB - activity report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 SET APCLJOB=$JOB
SET APCLBT=$HOROLOG
+3 DO XTMP^APCLOSUT(APCLNSP,"PCC ACTIVITY REPORT")
V ; Run by visit date
+1 SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLODAT=""
SET APCLET=$HOROLOG
QUIT
+2 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+3 SET APCLET=$HOROLOG
+4 QUIT
V1 ;
+1 SET APCLVDFN=0
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
SET APCLVREC=^(0)
DO PROC
DO EOJ
+2 QUIT
PROC ;
+1 KILL APCLSKIP
+2 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+3 IF '$PIECE(APCLVREC,U,9)
QUIT
+4 IF $PIECE(APCLVREC,U,11)
QUIT
+5 IF "DXECH"[$PIECE(APCLVREC,U,7)
QUIT
+6 IF "V"[$PIECE(APCLVREC,U,3)
QUIT
+7 IF $DATA(APCLLOC)
IF $PIECE(APCLVREC,U,6)=""
QUIT
IF '$DATA(APCLLOC($PIECE(APCLVREC,U,6)))
QUIT
+8 IF $DATA(APCLCLN)
IF $PIECE(APCLVREC,U,8)=""
QUIT
IF '$DATA(APCLCLN($PIECE(APCLVREC,U,8)))
QUIT
+9 IF '$DATA(^AUPNVPOV("AD",APCLVDFN))
QUIT
+10 IF '$DATA(^AUPNVPRV("AD",APCLVDFN))
QUIT
+11 SET (APCL1,APCL2)=0
FOR L=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)
+12 IF APCL1=0
QUIT
+13 IF APCL1>1
QUIT
+14 SET APCLVLOC=$PIECE(APCLVREC,U,6)
+15 IF APCLVLOC=""
QUIT
+16 SET APCLSU=$PIECE(^AUTTLOC(APCLVLOC,0),U,5)
IF APCLSU=""
SET APCLSU="ZZZZ"
+17 DO PROC2
+18 QUIT
EOJ KILL APCLVLOC,APCLVREC,APCLSKIP,APCL1,APCL2,APCLX,APCLY,APCLAP,APCLDISC,APCLVLOC,APCLVTM,APCLVTT
+1 QUIT
+2 ;
+3 ;
PROC2 ;
+1 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+2 SET APCLAP=$PIECE(^AUPNVPRV(APCLX,0),U)
+3 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
SET APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP)
IF '$DATA(^APCLACTG(APCLACTG,11,"AC",APCLDISC))
QUIT
GOTO PROC21
+4 SET APCLY=$PIECE(^DIC(6,APCLAP,0),U,4)
+5 IF APCLY=""
QUIT
+6 IF '$DATA(^DIC(7,APCLY,9999999))
QUIT
+7 SET APCLDISC=$PIECE(^DIC(7,APCLY,9999999),U)
IF '$DATA(^APCLACTG(APCLACTG,11,"AC",APCLDISC))
QUIT
PROC21 IF '$DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,"PATIENT",$PIECE(APCLVREC,U,5),@APCLSORV))
Begin DoDot:2
+1 SET ^("TOTAL")=$SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,@APCLSORV,APCLVLOC,"TOTAL")):^("TOTAL")+1,1:1)
SET ^XTMP(APCLNSP,APCLJOB,APCLBT,"PATIENT",$PIECE(APCLVREC,U,5),@APCLSORV)=""
End DoDot:2
End DoDot:1
+2 QUIT
