APCDCAFV ; IHS/CMI/LAB - CODING QUEUE ROUTINE 16-AUG-1994 ;
;;2.0;IHS PCC SUITE;**2,8,11,15**;MAY 14, 2009;Build 11
;; ;
;
PROCESS ;EP
S APCDJ=$J,APCDH=$H,APCDGRTA=0,APCDGRTP=0
S ^XTMP("APCDCAFT",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC UNREVIEWED REPORT"
S APCDODAT=$P(APCDBD,".")-1,APCDODAT=APCDODAT_".9999"
S (APCDRCNT,APCDVIEN)=0 F S APCDODAT=$O(^AUPNVSIT("B",APCDODAT)) Q:APCDODAT=""!($P(APCDODAT,".")>$P(APCDED,".")) D
.S APCDVIEN=0 F S APCDVIEN=$O(^AUPNVSIT("B",APCDODAT,APCDVIEN)) Q:APCDVIEN'=+APCDVIEN D
..S APCDV0=$G(^AUPNVSIT(APCDVIEN,0))
..Q:APCDV0=""
..I $P(APCDV0,U,7)="I",'$D(^APCDSITE(DUZ(2),13,"B","I")) G N
..;Q:"AOSTCRN"'[$P(APCDV0,U,7) ;SERV CAT -LORI CHANGE THIS
..Q:'$$SCW^APCDCAF($P(APCDV0,U,7))
N ..;
..Q:'$P(APCDV0,U,9) ;NO DEP ENTRIES
..Q:$P(APCDV0,U,11) ;DELETED
..Q:$P(APCDV0,U,3)="C" ;CONTRACT
..;Q:'$D(^AUPNVPOV("AD",APCDVIEN)) ;no pov PER CAROLYN JOHNSON, INCLUDE THEM
..;Q:'$D(^AUPNVPRV("AD",APCDVIEN)) ;no provider
..S APCDVPP=$$PRIMPROV^APCLV(APCDVIEN,"I")
..;Q:'APCDVPP ;no primary provider
..S APCDVLOC=$P(APCDV0,U,6)
..Q:APCDVLOC="" ;no location of encounter
..I $D(APCDLOCS),'$D(APCDLOCS(APCDVLOC)) Q ;not a location we want
..S APCDVCLN=$P(APCDV0,U,8)
..I APCDVCLN="",$D(APCDCLNS) Q ;clinic blank and want certain clinics
..I $D(APCDCLNS),'$D(APCDCLNS(APCDVCLN)) Q ;not a CLINIC we want
..S APCDVHL=$P(APCDV0,U,22)
..I APCDVHL="",$D(APCDHLS) Q ;HOSP LOC blank and want certain HOSP LOCS
..I $D(APCDHLS),'$D(APCDHLS(APCDVHL)) Q ;not a HOSP LOC we want
..I APCDVPP="",$D(APCDPRVS) Q ;PRIM PROV blank and want certain PRIM PROVS
..I $D(APCDPRVS),'$D(APCDPRVS(APCDVPP)) Q ;not a PRIM PROV we want
..S APCDVCAS=$P($G(^AUPNVSIT(APCDVIEN,11)),U,11)
..I APCDVCAS="R" Q ;DON'T DISPLAY REVIEWED VISITS
..;I $D(APCDCASS),'$D(APCDCASS(APCDVCAS)) Q
..;S APCDVCDR=$$LASTCDR(APCDVIEN) ;last chart deficiency reason
..;I APCDVCDR="",$D(APCDCDRS) Q ;
..;I $D(APCDCDRS),'$D(APCDCDRS(APCDVCDR)) Q
..K APCDVCDR D GETVCDR^APCDCAFS(APCDVIEN,"APCDVCDR") ;GET ALL PENDING REASONS
..I '$D(APCDVCDR),$D(APCDCDRS) Q ;
..S G=0 I $D(APCDCDRS) D
...S X=0 F S X=$O(APCDVCDR(X)) Q:X'=+X I $D(APCDCDRS(X)) S G=1
..I $D(APCDCDRS),'G Q
..S $P(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$P($P(^AUPNVSIT(APCDVIEN,0),U),"."),$P(^AUPNVSIT(APCDVIEN,0),U,7)),U,1)=$P($G(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$P($P(^AUPNVSIT(APCDVIEN,0),U),"."),$P(^AUPNVSIT(APCDVIEN,0),U,7))),U,1)+1
..S APCDGRTA=APCDGRTA+1
..I 'APCDVPP D
...S $P(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$P($P(^AUPNVSIT(APCDVIEN,0),U),"."),$P(^AUPNVSIT(APCDVIEN,0),U,7)),U,2)=$P($G(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$P($P(^AUPNVSIT(APCDVIEN,0),U),"."),$P(^AUPNVSIT(APCDVIEN,0),U,7))),U,2)+1
...S APCDGRTP=APCDGRTP+1
..Q
.Q
Q
;
DATE(D) ;
NEW X,Y
S X=$P(D,".")
S X=$E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
S Y=$$FMTE^XLFDT(D,"2S"),Y=$P(Y,"@",2),Y=$P(Y,":",1,2)
Q X_"@"_Y
;
ERRORCHK ;
;check for no pov, .9999 or multiple primary providers
S APCDERR=""
I '$D(^AUPNVPOV("AD",APCDV)) S APCDERR="NO POV"
S X=0 F S X=$O(^AUPNVPOV("AD",APCDV,X)) Q:X'=+X D
.I $$VAL^XBDIQ1(9000010.07,X,.01)=".9999" S APCDERR=".9999 POV " Q
.I $$VAL^XBDIQ1(9000010.07,X,.01)="ZZZ.999" S APCDERR="ZZZ.999 POV "
S X=0,C=0 F S X=$O(^AUPNVPRV("AD",APCDV,X)) Q:X'=+X D
.I $P(^AUPNVPRV(X,0),U,4)="P" S C=C+1
I C>1 S APCDERR=APCDERR_"MULT PRIM PROV"
Q
RBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
Q V
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
;
LASTCDR(V,F) ;EP - get last chart deficiency reason
I $G(F)="" S F="I" ;default to ien
I '$D(^AUPNVCA("AD",V)) Q ""
NEW X,A,D,L
S X=0 F S X=$O(^AUPNVCA("AD",V,X)) Q:X'=+X D
.Q:'$D(^AUPNVCA(X,0))
.S D=$P(^AUPNVCA(X,0),U)
.S A((9999999-$P(D,".")))=X
S L=$O(A(0)) I L="" Q ""
S L=A(L)
Q $S(F="I":$P(^AUPNVCA(L,0),U,6),1:$$VAL^XBDIQ1(9000010.45,L,.06))
;
EOP ;EP - End of page.
Q:$E(IOST)'="C"
;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="Press Enter to Continue",DIR(0)="E" D ^DIR
Q
;----------
PRINT ;EP - called from xbdbque
S APCD80S="-------------------------------------------------------------------------------"
S Y=APCDBD D DD^%DT S APCDBDD=Y S Y=APCDED D DD^%DT S APCDEDD=Y
S APCDPG=0
K APCDQUIT
D COVPAGE
D PRINT1
DONE I $D(APCDET) S APCDDVTS=(86400*($P(APCDET,",")-$P(APCDBT,",")))+($P(APCDET,",",2)-$P(APCDBT,",",2)),APCDDVH=$P(APCDDVTS/3600,".") S:APCDDVH="" APCDDVH=0
S APCDDVTS=APCDDVTS-(APCDDVH*3600),APCDDVM=$P(APCDDVTS/60,".") S:APCDDVM="" APCDDVM=0 S APCDDVTS=APCDDVTS-(APCDDVM*60),APCDDVS=APCDDVTS W !!,"RUN TIME (H.M.S): ",APCDDVH,".",APCDDVM,".",APCDDVS
I $E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
W:$D(IOF) @IOF
XIT ; Clean up and exit
K ^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS")
D EN^XBVK("APCD")
Q
PRINT1 ; Print report 2
I $Y>(IOSL-3) D HEAD I 1
E D H1
I '$D(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS")) W !!,"There are no visits that are not already reviewed." Q
S APCDS="" F S APCDS=$O(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",APCDS)) Q:APCDS=""!($D(APCDQUIT)) D
.S APCDFRO=1 S APCDV="" F S APCDV=$O(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",APCDS,APCDV)) Q:APCDV=""!($D(APCDQUIT)) D
..I $Y>(IOSL-5) D HEAD Q:$D(APCDQUIT)
..D PRN1 S APCDFRO=""
.S APCDFRO=""
TOTALS ;
Q:$D(APCDQUIT)
I $Y>(IOSL-3) D HEAD Q:$D(APCDQUIT)
W !!,"Totals:",?35,APCDGRTA,?60,APCDGRTP
Q
PRN1 ;EP
S APCDX=^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",APCDS,APCDV)
W ! W:APCDFRO $$FMTE^XLFDT(APCDS) W ?19,$E($$EXTSET^XBFUNC(9000010,.07,APCDV),1,12),?35,$P(APCDX,U,1),?60,$P(APCDX,U,2)
;
Q
PAGEHEAD ;
HEAD ;EP;HEADER
I 'APCDPG G HEAD1
HEAD2 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
W !?29,"PCC Data Entry Module"
W !,$$CTR("******************************************************************",80)
W !,$$CTR("* COUNT OF VISITS WITH CHART AUDIT STATUS OF INCOMPLETE/BLANK *",80)
W !,$$CTR("******************************************************************",80)
H1 S X="VISIT Date Range: "_APCDBDD_" through "_APCDEDD W !,$$CTR(X,80)
W !!,"VISIT DATE",?19,"SERV CAT",?35,"# UNREVIEWED VISITS",?60,"# W/NO PROV",!,?60,"(ANCILLARY)"
W !,APCD80S
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
COVPAGE ;
W !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
W !?29,"PCC Data Entry Module"
W !,$$CTR("******************************************************************",80)
W !,$$CTR("* COUNT OF VISITS WITH CHART AUDIT STATUS OF INCOMPLETE/BLANK *",80)
W !,$$CTR("******************************************************************",80)
W !!,$$CTR("VISIT LIST CRITERIA",80)
W !!,"VISIT DATES: ",$$FMTE^XLFDT(APCDBD)," to ",$$FMTE^XLFDT(APCDED)
;W !,"SERVICE CATEGORY: A, O, S, C, T, M"
W !,"SERVICE CATEGORY: "
S X=$P(^DD(9000010,.07,0),U,3),D=""
F Y=1:1 S J=$P(X,";",Y) Q:J="" D
.S C=$P(J,":")
.Q:'$$SCW^APCDCAF(C)
.S:D]"" D=D_", "
.S D=D_C
W D
W !,"VISIT TYPE: NOT Contract"
W !!,"LOCATION OF ENCOUNTER: " D
.I '$D(APCLLOCS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDLOCS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^DIC(4,Y,0),U),1,15)
W !!,"CLINICS: " D
.I '$D(APCLCLNS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDCLNS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^DIC(40.7,Y,0),U),1,15)
W !!,"HOSPITAL LOCATIONS: " D
.I '$D(APCLHLS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDHLS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^SC(Y,0),U),1,15)
W !!,"PRIMARY PROVIDER ON VISIT: " D
.I '$D(APCLPRV) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDPRVS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^VA(200,Y,0),U),1,15)
;W !!,"CHART AUDIT STATUS: " D
;.I '$D(APCDCASS) W "All" Q
;.S Y=0,C=0 F S Y=$O(APCDCASS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$$EXTSET^XBFUNC(9000010.45,Y,.04)
W !!,"CHART DEFICIENCY REASONS: " D
.I '$D(APCLCDRS) W "All (includes visits with no chart deficiency reason entered" Q
.S Y=0,C=0 F S Y=$O(APCDCDRS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^AUTTCDR(Y,0),U),1,15)
Q
APCDCAFV ; IHS/CMI/LAB - CODING QUEUE ROUTINE 16-AUG-1994 ;
+1 ;;2.0;IHS PCC SUITE;**2,8,11,15**;MAY 14, 2009;Build 11
+2 ;; ;
+3 ;
PROCESS ;EP
+1 SET APCDJ=$JOB
SET APCDH=$HOROLOG
SET APCDGRTA=0
SET APCDGRTP=0
+2 SET ^XTMP("APCDCAFT",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"PCC UNREVIEWED REPORT"
+3 SET APCDODAT=$PIECE(APCDBD,".")-1
SET APCDODAT=APCDODAT_".9999"
+4 SET (APCDRCNT,APCDVIEN)=0
FOR
SET APCDODAT=$ORDER(^AUPNVSIT("B",APCDODAT))
IF APCDODAT=""!($PIECE(APCDODAT,".")>$PIECE(APCDED,"."))
QUIT
Begin DoDot:1
+5 SET APCDVIEN=0
FOR
SET APCDVIEN=$ORDER(^AUPNVSIT("B",APCDODAT,APCDVIEN))
IF APCDVIEN'=+APCDVIEN
QUIT
Begin DoDot:2
+6 SET APCDV0=$GET(^AUPNVSIT(APCDVIEN,0))
+7 IF APCDV0=""
QUIT
+8 IF $PIECE(APCDV0,U,7)="I"
IF '$DATA(^APCDSITE(DUZ(2),13,"B","I"))
GOTO N
+9 ;Q:"AOSTCRN"'[$P(APCDV0,U,7) ;SERV CAT -LORI CHANGE THIS
+10 IF '$$SCW^APCDCAF($PIECE(APCDV0,U,7))
QUIT
N ;
+1 ;NO DEP ENTRIES
IF '$PIECE(APCDV0,U,9)
QUIT
+2 ;DELETED
IF $PIECE(APCDV0,U,11)
QUIT
+3 ;CONTRACT
IF $PIECE(APCDV0,U,3)="C"
QUIT
+4 ;Q:'$D(^AUPNVPOV("AD",APCDVIEN)) ;no pov PER CAROLYN JOHNSON, INCLUDE THEM
+5 ;Q:'$D(^AUPNVPRV("AD",APCDVIEN)) ;no provider
+6 SET APCDVPP=$$PRIMPROV^APCLV(APCDVIEN,"I")
+7 ;Q:'APCDVPP ;no primary provider
+8 SET APCDVLOC=$PIECE(APCDV0,U,6)
+9 ;no location of encounter
IF APCDVLOC=""
QUIT
+10 ;not a location we want
IF $DATA(APCDLOCS)
IF '$DATA(APCDLOCS(APCDVLOC))
QUIT
+11 SET APCDVCLN=$PIECE(APCDV0,U,8)
+12 ;clinic blank and want certain clinics
IF APCDVCLN=""
IF $DATA(APCDCLNS)
QUIT
+13 ;not a CLINIC we want
IF $DATA(APCDCLNS)
IF '$DATA(APCDCLNS(APCDVCLN))
QUIT
+14 SET APCDVHL=$PIECE(APCDV0,U,22)
+15 ;HOSP LOC blank and want certain HOSP LOCS
IF APCDVHL=""
IF $DATA(APCDHLS)
QUIT
+16 ;not a HOSP LOC we want
IF $DATA(APCDHLS)
IF '$DATA(APCDHLS(APCDVHL))
QUIT
+17 ;PRIM PROV blank and want certain PRIM PROVS
IF APCDVPP=""
IF $DATA(APCDPRVS)
QUIT
+18 ;not a PRIM PROV we want
IF $DATA(APCDPRVS)
IF '$DATA(APCDPRVS(APCDVPP))
QUIT
+19 SET APCDVCAS=$PIECE($GET(^AUPNVSIT(APCDVIEN,11)),U,11)
+20 ;DON'T DISPLAY REVIEWED VISITS
IF APCDVCAS="R"
QUIT
+21 ;I $D(APCDCASS),'$D(APCDCASS(APCDVCAS)) Q
+22 ;S APCDVCDR=$$LASTCDR(APCDVIEN) ;last chart deficiency reason
+23 ;I APCDVCDR="",$D(APCDCDRS) Q ;
+24 ;I $D(APCDCDRS),'$D(APCDCDRS(APCDVCDR)) Q
+25 ;GET ALL PENDING REASONS
KILL APCDVCDR
DO GETVCDR^APCDCAFS(APCDVIEN,"APCDVCDR")
+26 ;
IF '$DATA(APCDVCDR)
IF $DATA(APCDCDRS)
QUIT
+27 SET G=0
IF $DATA(APCDCDRS)
Begin DoDot:3
+28 SET X=0
FOR
SET X=$ORDER(APCDVCDR(X))
IF X'=+X
QUIT
IF $DATA(APCDCDRS(X))
SET G=1
End DoDot:3
+29 IF $DATA(APCDCDRS)
IF 'G
QUIT
+30 SET $PIECE(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$PIECE($PIECE(^AUPNVSIT(APCDVIEN,0),U),"."),$PIECE(^AUPNVSIT(APCDVIEN,0),U,7)),U,1)=...
... $PIECE($GET(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$PIECE($PIECE(^AUPNVSIT(APCDVIEN,0),U),"."),$PIECE(^AUPNVSIT(APCDVIEN,0),U,7))),U,1)+1
+31 SET APCDGRTA=APCDGRTA+1
+32 IF 'APCDVPP
Begin DoDot:3
+33 SET $PIECE(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$PIECE($PIECE(^AUPNVSIT(APCDVIEN,0),U),"."),$PIECE(^AUPNVSIT(APCDVIEN,0),U,7)),U,2)=...
... $PIECE($GET(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",$PIECE($PIECE(^AUPNVSIT(APCDVIEN,0),U),"."),$PIECE(^AUPNVSIT(APCDVIEN,0),U,7))),U,2)+1
+34 SET APCDGRTP=APCDGRTP+1
End DoDot:3
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 QUIT
+38 ;
DATE(D) ;
+1 NEW X,Y
+2 SET X=$PIECE(D,".")
+3 SET X=$EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
+4 SET Y=$$FMTE^XLFDT(D,"2S")
SET Y=$PIECE(Y,"@",2)
SET Y=$PIECE(Y,":",1,2)
+5 QUIT X_"@"_Y
+6 ;
ERRORCHK ;
+1 ;check for no pov, .9999 or multiple primary providers
+2 SET APCDERR=""
+3 IF '$DATA(^AUPNVPOV("AD",APCDV))
SET APCDERR="NO POV"
+4 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",APCDV,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 IF $$VAL^XBDIQ1(9000010.07,X,.01)=".9999"
SET APCDERR=".9999 POV "
QUIT
+6 IF $$VAL^XBDIQ1(9000010.07,X,.01)="ZZZ.999"
SET APCDERR="ZZZ.999 POV "
End DoDot:1
+7 SET X=0
SET C=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCDV,X))
IF X'=+X
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNVPRV(X,0),U,4)="P"
SET C=C+1
End DoDot:1
+9 IF C>1
SET APCDERR=APCDERR_"MULT PRIM PROV"
+10 QUIT
RBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_" "
+3 QUIT V
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
+4 ;
LASTCDR(V,F) ;EP - get last chart deficiency reason
+1 ;default to ien
IF $GET(F)=""
SET F="I"
+2 IF '$DATA(^AUPNVCA("AD",V))
QUIT ""
+3 NEW X,A,D,L
+4 SET X=0
FOR
SET X=$ORDER(^AUPNVCA("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 IF '$DATA(^AUPNVCA(X,0))
QUIT
+6 SET D=$PIECE(^AUPNVCA(X,0),U)
+7 SET A((9999999-$PIECE(D,".")))=X
End DoDot:1
+8 SET L=$ORDER(A(0))
IF L=""
QUIT ""
+9 SET L=A(L)
+10 QUIT $SELECT(F="I":$PIECE(^AUPNVCA(L,0),U,6),1:$$VAL^XBDIQ1(9000010.45,L,.06))
+11 ;
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 ;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="Press Enter to Continue"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
PRINT ;EP - called from xbdbque
+1 SET APCD80S="-------------------------------------------------------------------------------"
+2 SET Y=APCDBD
DO DD^%DT
SET APCDBDD=Y
SET Y=APCDED
DO DD^%DT
SET APCDEDD=Y
+3 SET APCDPG=0
+4 KILL APCDQUIT
+5 DO COVPAGE
+6 DO PRINT1
DONE IF $DATA(APCDET)
SET APCDDVTS=(86400*($PIECE(APCDET,",")-$PIECE(APCDBT,",")))+($PIECE(APCDET,",",2)-$PIECE(APCDBT,",",2))
SET APCDDVH=$PIECE(APCDDVTS/3600,".")
IF APCDDVH=""
SET APCDDVH=0
+1 SET APCDDVTS=APCDDVTS-(APCDDVH*3600)
SET APCDDVM=$PIECE(APCDDVTS/60,".")
IF APCDDVM=""
SET APCDDVM=0
SET APCDDVTS=APCDDVTS-(APCDDVM*60)
SET APCDDVS=APCDDVTS
WRITE !!,"RUN TIME (H.M.S): ",APCDDVH,".",APCDDVM,".",APCDDVS
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF $DATA(IOF)
WRITE @IOF
XIT ; Clean up and exit
+1 KILL ^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS")
+2 DO EN^XBVK("APCD")
+3 QUIT
PRINT1 ; Print report 2
+1 IF $Y>(IOSL-3)
DO HEAD
IF 1
+2 IF '$TEST
DO H1
+3 IF '$DATA(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS"))
WRITE !!,"There are no visits that are not already reviewed."
QUIT
+4 SET APCDS=""
FOR
SET APCDS=$ORDER(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",APCDS))
IF APCDS=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+5 SET APCDFRO=1
SET APCDV=""
FOR
SET APCDV=$ORDER(^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",APCDS,APCDV))
IF APCDV=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+7 DO PRN1
SET APCDFRO=""
End DoDot:2
+8 SET APCDFRO=""
End DoDot:1
TOTALS ;
+1 IF $DATA(APCDQUIT)
QUIT
+2 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+3 WRITE !!,"Totals:",?35,APCDGRTA,?60,APCDGRTP
+4 QUIT
PRN1 ;EP
+1 SET APCDX=^XTMP("APCDCAFT",APCDJ,APCDH,"VISITS",APCDS,APCDV)
+2 WRITE !
IF APCDFRO
WRITE $$FMTE^XLFDT(APCDS)
WRITE ?19,$EXTRACT($$EXTSET^XBFUNC(9000010,.07,APCDV),1,12),?35,$PIECE(APCDX,U,1),?60,$PIECE(APCDX,U,2)
+3 ;
+4 QUIT
PAGEHEAD ;
HEAD ;EP;HEADER
+1 IF 'APCDPG
GOTO HEAD1
HEAD2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCDQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
+3 WRITE !?29,"PCC Data Entry Module"
+4 WRITE !,$$CTR("******************************************************************",80)
+5 WRITE !,$$CTR("* COUNT OF VISITS WITH CHART AUDIT STATUS OF INCOMPLETE/BLANK *",80)
+6 WRITE !,$$CTR("******************************************************************",80)
H1 SET X="VISIT Date Range: "_APCDBDD_" through "_APCDEDD
WRITE !,$$CTR(X,80)
+1 WRITE !!,"VISIT DATE",?19,"SERV CAT",?35,"# UNREVIEWED VISITS",?60,"# W/NO PROV",!,?60,"(ANCILLARY)"
+2 WRITE !,APCD80S
+3 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
COVPAGE ;
+1 WRITE !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
+2 WRITE !?29,"PCC Data Entry Module"
+3 WRITE !,$$CTR("******************************************************************",80)
+4 WRITE !,$$CTR("* COUNT OF VISITS WITH CHART AUDIT STATUS OF INCOMPLETE/BLANK *",80)
+5 WRITE !,$$CTR("******************************************************************",80)
+6 WRITE !!,$$CTR("VISIT LIST CRITERIA",80)
+7 WRITE !!,"VISIT DATES: ",$$FMTE^XLFDT(APCDBD)," to ",$$FMTE^XLFDT(APCDED)
+8 ;W !,"SERVICE CATEGORY: A, O, S, C, T, M"
+9 WRITE !,"SERVICE CATEGORY: "
+10 SET X=$PIECE(^DD(9000010,.07,0),U,3)
SET D=""
+11 FOR Y=1:1
SET J=$PIECE(X,";",Y)
IF J=""
QUIT
Begin DoDot:1
+12 SET C=$PIECE(J,":")
+13 IF '$$SCW^APCDCAF(C)
QUIT
+14 IF D]""
SET D=D_", "
+15 SET D=D_C
End DoDot:1
+16 WRITE D
+17 WRITE !,"VISIT TYPE: NOT Contract"
+18 WRITE !!,"LOCATION OF ENCOUNTER: "
Begin DoDot:1
+19 IF '$DATA(APCLLOCS)
WRITE "All"
QUIT
+20 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDLOCS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^DIC(4,Y,0),U),1,15)
End DoDot:1
+21 WRITE !!,"CLINICS: "
Begin DoDot:1
+22 IF '$DATA(APCLCLNS)
WRITE "All"
QUIT
+23 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDCLNS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^DIC(40.7,Y,0),U),1,15)
End DoDot:1
+24 WRITE !!,"HOSPITAL LOCATIONS: "
Begin DoDot:1
+25 IF '$DATA(APCLHLS)
WRITE "All"
QUIT
+26 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDHLS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^SC(Y,0),U),1,15)
End DoDot:1
+27 WRITE !!,"PRIMARY PROVIDER ON VISIT: "
Begin DoDot:1
+28 IF '$DATA(APCLPRV)
WRITE "All"
QUIT
+29 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDPRVS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^VA(200,Y,0),U),1,15)
End DoDot:1
+30 ;W !!,"CHART AUDIT STATUS: " D
+31 ;.I '$D(APCDCASS) W "All" Q
+32 ;.S Y=0,C=0 F S Y=$O(APCDCASS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$$EXTSET^XBFUNC(9000010.45,Y,.04)
+33 WRITE !!,"CHART DEFICIENCY REASONS: "
Begin DoDot:1
+34 IF '$DATA(APCLCDRS)
WRITE "All (includes visits with no chart deficiency reason entered"
QUIT
+35 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDCDRS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^AUTTCDR(Y,0),U),1,15)
End DoDot:1
+36 QUIT
