- 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
