APCLAP31 ; IHS/CMI/LAB - visits by provider process ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
S APCLBT=$H
K ^XTMP("APCLAP3",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLAP3","PCC - ALL VISITS BY PROV")
V ; Run by visit date
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
;
END ;
S APCLET=$H
Q
V1 ;
S V="" F S V=$O(^AUPNVSIT("B",APCLODAT,V)) Q:V'=+V I $D(^AUPNVSIT(V,0)) S APCLVREC=^(0) D
.K APCLSKIP
.Q:'$P(APCLVREC,U,9)
.Q:$P(APCLVREC,U,11)
.Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
.I $$CHKLOC^APCLOCCK(APCLLOC,$P(APCLVREC,U,6))=0 Q
.Q:'$D(^AUPNVPOV("AD",V))
.Q:'$D(^AUPNVPRV("AD",V))
.S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""
.S APCLCAT=$P(APCLVREC,U,7)
.S DIQ(0)="E",DA=V,DIC="^AUPNVSIT(",DR=".07" D EN^DIQ1 S APCLCAT=^UTILITY("DIQ1",$J,9000010,DA,".07","E")
.K ^UTILITY("DIQ1",$J)
.S B=0 F S B=$O(^AUPNVPRV("AD",V,B)) Q:B="" D
..I APCLPRIM,$P(^AUPNVPRV(B,0),U,4)'="P" Q
..S P=$P(^AUPNVPRV(B,0),U)
..S F=0
..D @APCLPSRT
..Q:'F
..S ^(APCLCAT)=$S($D(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,APCLVLOC,APCLCAT)):^(APCLCAT)+1,1:1)
..S ^("TOTAL")=$S($D(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,"TOTAL")):^("TOTAL")+1,1:1)
..Q
.Q
Q
;
P ;
I $D(APCLCDIS) S S="" D D Q:S=""
S S=P,F=1
Q
;
O ;
Q:APCLPROV'=P
S S=P,F=1
Q
;
D ;
I $P(^DD(9000010.06,.01,0),U,2)[6 G D6
Q:'$D(^VA(200,P))
S Y=$$PROVCLS^XBFUNC1(P,"I")
Q:'Y
Q:APCLDISC'=Y
S S=APCLDISC
S F=1
Q
D6 ;
Q:'$D(^DIC(6,P))
S Y=$P(^DIC(6,P,0),U,4)
Q:Y=""
Q:APCLDISC'=Y
S S=APCLDISC
S F=1
Q
;
A ;
I $P(^DD(9000010.06,.01,0),U,2)[6 G A6
Q:'$D(^VA(200,P))
S Y=$$PROVCLS^XBFUNC1(P,"I")
Q:'Y
S S=Y
S F=1
Q
A6 ;
Q:'$D(^DIC(6,P))
S Y=$P(^DIC(6,P,0),U,4)
Q:Y=""
S S=Y
S F=1
Q
;
APCLAP31 ; IHS/CMI/LAB - visits by provider process ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
+1 SET APCLBT=$HOROLOG
+2 KILL ^XTMP("APCLAP3",APCLJOB,APCLBTH)
+3 DO XTMP^APCLOSUT("APCLAP3","PCC - ALL VISITS BY PROV")
V ; Run by visit date
+1 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+2 ;
END ;
+1 SET APCLET=$HOROLOG
+2 QUIT
V1 ;
+1 SET V=""
FOR
SET V=$ORDER(^AUPNVSIT("B",APCLODAT,V))
IF V'=+V
QUIT
IF $DATA(^AUPNVSIT(V,0))
SET APCLVREC=^(0)
Begin DoDot:1
+2 KILL APCLSKIP
+3 IF '$PIECE(APCLVREC,U,9)
QUIT
+4 IF $PIECE(APCLVREC,U,11)
QUIT
+5 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+6 IF $$CHKLOC^APCLOCCK(APCLLOC,$PIECE(APCLVREC,U,6))=0
QUIT
+7 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+8 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+9 SET APCLVLOC=$PIECE(APCLVREC,U,6)
IF APCLVLOC=""
QUIT
+10 SET APCLCAT=$PIECE(APCLVREC,U,7)
+11 SET DIQ(0)="E"
SET DA=V
SET DIC="^AUPNVSIT("
SET DR=".07"
DO EN^DIQ1
SET APCLCAT=^UTILITY("DIQ1",$JOB,9000010,DA,".07","E")
+12 KILL ^UTILITY("DIQ1",$JOB)
+13 SET B=0
FOR
SET B=$ORDER(^AUPNVPRV("AD",V,B))
IF B=""
QUIT
Begin DoDot:2
+14 IF APCLPRIM
IF $PIECE(^AUPNVPRV(B,0),U,4)'="P"
QUIT
+15 SET P=$PIECE(^AUPNVPRV(B,0),U)
+16 SET F=0
+17 DO @APCLPSRT
+18 IF 'F
QUIT
+19 SET ^(APCLCAT)=$SELECT($DATA(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,APCLVLOC,APCLCAT)):^(APCLCAT)+1,1:1)
+20 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCLAP3",APCLJOB,APCLBTH,S,"TOTAL")):^("TOTAL")+1,1:1)
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
P ;
+1 IF $DATA(APCLCDIS)
SET S=""
DO D
IF S=""
QUIT
+2 SET S=P
SET F=1
+3 QUIT
+4 ;
O ;
+1 IF APCLPROV'=P
QUIT
+2 SET S=P
SET F=1
+3 QUIT
+4 ;
D ;
+1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
GOTO D6
+2 IF '$DATA(^VA(200,P))
QUIT
+3 SET Y=$$PROVCLS^XBFUNC1(P,"I")
+4 IF 'Y
QUIT
+5 IF APCLDISC'=Y
QUIT
+6 SET S=APCLDISC
+7 SET F=1
+8 QUIT
D6 ;
+1 IF '$DATA(^DIC(6,P))
QUIT
+2 SET Y=$PIECE(^DIC(6,P,0),U,4)
+3 IF Y=""
QUIT
+4 IF APCLDISC'=Y
QUIT
+5 SET S=APCLDISC
+6 SET F=1
+7 QUIT
+8 ;
A ;
+1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
GOTO A6
+2 IF '$DATA(^VA(200,P))
QUIT
+3 SET Y=$$PROVCLS^XBFUNC1(P,"I")
+4 IF 'Y
QUIT
+5 SET S=Y
+6 SET F=1
+7 QUIT
A6 ;
+1 IF '$DATA(^DIC(6,P))
QUIT
+2 SET Y=$PIECE(^DIC(6,P,0),U,4)
+3 IF Y=""
QUIT
+4 SET S=Y
+5 SET F=1
+6 QUIT
+7 ;
