APCDDVW ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
S APCDDT=$$FMTE^XLFDT(DT)
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 @APCDT
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 APCDDT,APCDLC,APCDV,APCDBS,APCDV2,APCDL,APCDECNT,APCDVR,APCDRD,DFN,APCDH,APCP,APCDFILE,APCDE,APCDPROC,APCD80S,APCDPG,APCDBDD,APCDEDD,APCDET,APCDQUIT,APCDDEM,APCDVFLE,APCDVDG,APCDVIGR,APCDVDFN,APCDDEMM
K APCDDVS,APCDDVTS,Y,X,APCDDVM,APCDDVH
Q
ZERO ; Write zero dependent report
D ZERO^APCDDVW1
Q
PPPV ; Print report 2
D HEAD
W !!,"TOTAL NUMBER OF ERRORS ON THIS PPPV REPORT: ",$G(APCDCNTR("PPPV")),!!
I '$D(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV")) W !!,"There are no visits on or after ",$S(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date " S Y=APCDBD D DT^DIO2 S Y="" W !,"with no Primary Provider and/or POV." Q
S APCDCL=0 F S APCDCL=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL)) Q:APCDCL'=+APCDCL!($D(APCDQUIT)) S APCDCLIN="" F S APCDCLIN=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN)) Q:APCDCLIN=""!($D(APCDQUIT)) D
.S APCDH="" F S APCDH=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH)) Q:APCDH=""!($D(APCDQUIT)) D
..S APCDV=0 F S APCDV=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH,APCDV)) Q:APCDV'=+APCDV!($D(APCDQUIT)) D:$Y>(IOSL-10) HEAD^APCDDVW Q:$D(APCDQUIT) D PRN1,DE,ER
Q
DE ;EP;FIND DEP ENTRIES
W !?10,"This visit has: "
S APCDVFLE=9000010 F S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D DE2
Q
;
DE2 ;
S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDV,APCDVDFN)"
S APCDVDFN="" I $O(@APCDVIGR)]"" W ?27,$P($P(^DIC(APCDVFLE,0),U),"V ",2),"'s",!
K APCDAPOV,APCDAPRV
F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN="" D
.S APCDK12N=APCDVDG_APCDVDFN_",12)",APCDK12D=""
.I $D(@(APCDK12N)) S APCDK12D=@(APCDK12N)
.S APCDK16N="",APCDK16D="" I APCDVFLE=9000010.09 S APCDK16N=APCDVDG_APCDVDFN_",16)" I $D(@(APCDK16N)) S APCDK16D=@(APCDK16N)
.I $P(APCDK16D,U)]"" S APCDAPOV($P(APCDK16D,U))=""
.I $P(APCDK12D,U,13)]"" S APCDAPOV($P(APCDK12D,U,13))=""
.I $P(APCDK12D,U,2)]"" S APCDAPRV($P(^DIC(APCDVFLE,0),U)_" - "_$P($G(^VA(200,$P(APCDK12D,U,2),0)),U))=""
.I $P(APCDK12D,U,4)]"" S APCDAPRV($P(^DIC(APCDVFLE,0),U)_" - "_$P($G(^VA(200,$P(APCDK12D,U,4),0)),U))=""
I $G(APCDDOPP) D
.I $D(APCDAPRV) D
..W !,"Ordering Providers:",!
..S APCDX="" F S APCDX=$O(APCDAPRV(APCDX)) Q:APCDX=""!($D(APCDQUIT)) D
...D HEAD Q:$D(APCDQUIT)
...W ?3,APCDX,!
I $G(APCDDLPV) D
.I $D(APCDAPOV) D
..W !,"Lab Diagnoses: ",!
..S APCDX="" F S APCDX=$O(APCDAPOV(APCDX)) Q:APCDX=""!($D(APCDQUIT)) D
...D HEAD Q:$D(APCDQUIT)
...W ?3,APCDX,!
Q
;
MRG ;
D MRG^APCDDVW1
Q
TXER ;
D TXER^APCDDVW2
Q
ER ;
S APCDV2=0 F S APCDV2=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH,APCDV,APCDV2)) Q:APCDV2=""!($D(APCDQUIT)) W:APCDV2>1 ! W ?5,^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH,APCDV,APCDV2)
Q
PRN1 ;EP
S APCDVR=^AUPNVSIT(APCDV,0) S:'$P(APCDVR,U,6) $P(APCDVR,U,6)=0
S DFN=$P(APCDVR,U,5)
S Y=+APCDVR X ^DD("DD") S APCDRD=Y
W !!," HRN FAC: [",$P(^AUTTLOC(APCDCL,0),U,7),"] HRN: [",APCDH,"] NAME: [",$P(^DPT(DFN,0),U),"]"
W !," DATE: [",APCDRD,"] LOCATION: [",$S($D(^DIC(4,$P(APCDVR,U,6),0)):$P(^(0),U),1:"UNKNOWN"),"]"
W !," SERVICE CATEGORY: [",$P(APCDVR,U,7),"] TYPE: [",$P(APCDVR,U,3),"] CLINIC: [",$S($P(APCDVR,U,8)]"":$P(^DIC(40.7,$P(APCDVR,U,8),0),U),1:"NONE"),"]"
I $P($G(^AUPNVSIT(APCDV,12)),U,11)]"" W !," Ext Acct #: ",$P($G(^AUPNVSIT(APCDV,12)),U,11) ;IHS/CMI/LAB - added acct # display
I APCDT'="PPPV",$P(APCDVR,U,9) W !," DEPENDENT ENTRIES: [",$P(APCDVR,U,9),"]" D DISPPP^APCDDVW1
;
Q
;
INPT ;
D INPT^APCDDVW1
Q
ALL ;
S APCDT="ZERO" D ZERO Q:$D(APCDQUIT)
S APCDT="PPPV" D PPPV Q:$D(APCDQUIT)
S APCDT="MRG" D MRG Q:$D(APCDQUIT)
S APCDT="TXER" D TXER Q:$D(APCDQUIT)
S APCDT="INPT" D INPT Q:$D(APCDQUIT)
Q
;
PPPVSUB W !,"THE FOLLOWING VISITS DO NOT HAVE EITHER A PRIMARY PROVIDER OR PURPOSE OF VISIT"
Q
ZEROSUB W !,"VISITS WITH A ZERO DEPENDENT ENTRY COUNT -- POTENTIAL DELETIONS"
Q
TXERSUB ;
W !,"LIST OF VISITS WITH TRANSACTION ERRORS"
I $D(APCDDEMM) W "----MANDATORY DEMOGRAPHIC DATA ITEMS",!,"*******MUST BE CORRECTED IN ORDER FOR DATA TO BE TRANSMITTED*******"
I $D(APCDDEM) W "----DEMOGRAPHIC ERRORS (PAT REG)"
Q
MRGSUB ;
W !,"MULTIPLE VISITS ON ONE DAY;POTENTIAL MERGES"
Q
INPTSUB ;
W !,"VISITS WITH INPATIENT EDIT ERRORS"
Q
PAGEHEAD ;
HEAD ;EP;HEADER
G:$D(APCDDEM)!($D(APCDDEMM)) HEAD2
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 !,APCDDT,?70,"Page: ",APCDPG
W !?29,"PCC Data Entry Module"
W !?23,"*********************************"
W !?23,"* VISIT REVIEW ERROR REPORT *"
W !?23,"*********************************"
W !!,"Report of Errors for ",$S(APCDPROC="P":"Posting",APCDPROC="V":"VISIT",1:"Posting")," Date Range: ",APCDBDD," through ",APCDEDD
S X=$S(APCDLOCT="A":"ALL Locations Included",APCDLOCT="O":"Location of Encounter: "_$P(^DIC(4,APCDLOCT("ONE"),0),U),APCDLOCT="S":"LOCATIONs Included: ALL Within the "_$P(^AUTTSU(APCDLOCT("SU"),0),U)_" Service Unit",1:"")
W !?(80-$L(X)/2),X
W !,APCD80S
D @(APCDT_"SUB")
W !,APCD80S
Q
APCDDVW ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 SET APCDDT=$$FMTE^XLFDT(DT)
+2 SET APCD80S="-------------------------------------------------------------------------------"
+3 SET Y=APCDBD
DO DD^%DT
SET APCDBDD=Y
SET Y=APCDED
DO DD^%DT
SET APCDEDD=Y
+4 SET APCDPG=0
+5 KILL APCDQUIT
+6 DO @APCDT
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 APCDDT,APCDLC,APCDV,APCDBS,APCDV2,APCDL,APCDECNT,APCDVR,APCDRD,DFN,APCDH,APCP,APCDFILE,APCDE,APCDPROC,APCD80S,APCDPG,APCDBDD,APCDEDD,APCDET,APCDQUIT,APCDDEM,APCDVFLE,APCDVDG,APCDVIGR,APCDVDFN,APCDDEMM
+2 KILL APCDDVS,APCDDVTS,Y,X,APCDDVM,APCDDVH
+3 QUIT
ZERO ; Write zero dependent report
+1 DO ZERO^APCDDVW1
+2 QUIT
PPPV ; Print report 2
+1 DO HEAD
+2 WRITE !!,"TOTAL NUMBER OF ERRORS ON THIS PPPV REPORT: ",$GET(APCDCNTR("PPPV")),!!
+3 IF '$DATA(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV"))
WRITE !!,"There are no visits on or after ",$SELECT(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date "
SET Y=APCDBD
DO DT^DIO2
SET Y=""
WRITE !,"with no Primary Provider and/or POV."
QUIT
+4 SET APCDCL=0
FOR
SET APCDCL=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL))
IF APCDCL'=+APCDCL!($DATA(APCDQUIT))
QUIT
SET APCDCLIN=""
FOR
SET APCDCLIN=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN))
IF APCDCLIN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+5 SET APCDH=""
FOR
SET APCDH=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH))
IF APCDH=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+6 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH,APCDV))
IF APCDV'=+APCDV!($DATA(APCDQUIT))
QUIT
IF $Y>(IOSL-10)
DO HEAD^APCDDVW
IF $DATA(APCDQUIT)
QUIT
DO PRN1
DO DE
DO ER
End DoDot:2
End DoDot:1
+7 QUIT
DE ;EP;FIND DEP ENTRIES
+1 WRITE !?10,"This visit has: "
+2 SET APCDVFLE=9000010
FOR
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
DO DE2
+3 QUIT
+4 ;
DE2 ;
+1 SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDV,APCDVDFN)"
+2 SET APCDVDFN=""
IF $ORDER(@APCDVIGR)]""
WRITE ?27,$PIECE($PIECE(^DIC(APCDVFLE,0),U),"V ",2),"'s",!
+3 KILL APCDAPOV,APCDAPRV
+4 FOR APCDVI=1:1
SET APCDVDFN=$ORDER(@APCDVIGR)
IF APCDVDFN=""
QUIT
Begin DoDot:1
+5 SET APCDK12N=APCDVDG_APCDVDFN_",12)"
SET APCDK12D=""
+6 IF $DATA(@(APCDK12N))
SET APCDK12D=@(APCDK12N)
+7 SET APCDK16N=""
SET APCDK16D=""
IF APCDVFLE=9000010.09
SET APCDK16N=APCDVDG_APCDVDFN_",16)"
IF $DATA(@(APCDK16N))
SET APCDK16D=@(APCDK16N)
+8 IF $PIECE(APCDK16D,U)]""
SET APCDAPOV($PIECE(APCDK16D,U))=""
+9 IF $PIECE(APCDK12D,U,13)]""
SET APCDAPOV($PIECE(APCDK12D,U,13))=""
+10 IF $PIECE(APCDK12D,U,2)]""
SET APCDAPRV($PIECE(^DIC(APCDVFLE,0),U)_" - "_$PIECE($GET(^VA(200,$PIECE(APCDK12D,U,2),0)),U))=""
+11 IF $PIECE(APCDK12D,U,4)]""
SET APCDAPRV($PIECE(^DIC(APCDVFLE,0),U)_" - "_$PIECE($GET(^VA(200,$PIECE(APCDK12D,U,4),0)),U))=""
End DoDot:1
+12 IF $GET(APCDDOPP)
Begin DoDot:1
+13 IF $DATA(APCDAPRV)
Begin DoDot:2
+14 WRITE !,"Ordering Providers:",!
+15 SET APCDX=""
FOR
SET APCDX=$ORDER(APCDAPRV(APCDX))
IF APCDX=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:3
+16 DO HEAD
IF $DATA(APCDQUIT)
QUIT
+17 WRITE ?3,APCDX,!
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF $GET(APCDDLPV)
Begin DoDot:1
+19 IF $DATA(APCDAPOV)
Begin DoDot:2
+20 WRITE !,"Lab Diagnoses: ",!
+21 SET APCDX=""
FOR
SET APCDX=$ORDER(APCDAPOV(APCDX))
IF APCDX=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:3
+22 DO HEAD
IF $DATA(APCDQUIT)
QUIT
+23 WRITE ?3,APCDX,!
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
MRG ;
+1 DO MRG^APCDDVW1
+2 QUIT
TXER ;
+1 DO TXER^APCDDVW2
+2 QUIT
ER ;
+1 SET APCDV2=0
FOR
SET APCDV2=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH,APCDV,APCDV2))
IF APCDV2=""!($DATA(APCDQUIT))
QUIT
IF APCDV2>1
WRITE !
WRITE ?5,^XTMP("APCDDV",APCDJOB,APCDBT,"PPPV",APCDCL,APCDCLIN,APCDH,APCDV,APCDV2)
+2 QUIT
PRN1 ;EP
+1 SET APCDVR=^AUPNVSIT(APCDV,0)
IF '$PIECE(APCDVR,U,6)
SET $PIECE(APCDVR,U,6)=0
+2 SET DFN=$PIECE(APCDVR,U,5)
+3 SET Y=+APCDVR
XECUTE ^DD("DD")
SET APCDRD=Y
+4 WRITE !!," HRN FAC: [",$PIECE(^AUTTLOC(APCDCL,0),U,7),"] HRN: [",APCDH,"] NAME: [",$PIECE(^DPT(DFN,0),U),"]"
+5 WRITE !," DATE: [",APCDRD,"] LOCATION: [",$SELECT($DATA(^DIC(4,$PIECE(APCDVR,U,6),0)):$PIECE(^(0),U),1:"UNKNOWN"),"]"
+6 WRITE !," SERVICE CATEGORY: [",$PIECE(APCDVR,U,7),"] TYPE: [",$PIECE(APCDVR,U,3),"] CLINIC: [",$SELECT($PIECE(APCDVR,U,8)]"":$PIECE(^DIC(40.7,$PIECE(APCDVR,U,8),0),U),1:"NONE"),"]"
+7 ;IHS/CMI/LAB - added acct # display
IF $PIECE($GET(^AUPNVSIT(APCDV,12)),U,11)]""
WRITE !," Ext Acct #: ",$PIECE($GET(^AUPNVSIT(APCDV,12)),U,11)
+8 IF APCDT'="PPPV"
IF $PIECE(APCDVR,U,9)
WRITE !," DEPENDENT ENTRIES: [",$PIECE(APCDVR,U,9),"]"
DO DISPPP^APCDDVW1
+9 ;
+10 QUIT
+11 ;
INPT ;
+1 DO INPT^APCDDVW1
+2 QUIT
ALL ;
+1 SET APCDT="ZERO"
DO ZERO
IF $DATA(APCDQUIT)
QUIT
+2 SET APCDT="PPPV"
DO PPPV
IF $DATA(APCDQUIT)
QUIT
+3 SET APCDT="MRG"
DO MRG
IF $DATA(APCDQUIT)
QUIT
+4 SET APCDT="TXER"
DO TXER
IF $DATA(APCDQUIT)
QUIT
+5 SET APCDT="INPT"
DO INPT
IF $DATA(APCDQUIT)
QUIT
+6 QUIT
+7 ;
PPPVSUB WRITE !,"THE FOLLOWING VISITS DO NOT HAVE EITHER A PRIMARY PROVIDER OR PURPOSE OF VISIT"
+1 QUIT
ZEROSUB WRITE !,"VISITS WITH A ZERO DEPENDENT ENTRY COUNT -- POTENTIAL DELETIONS"
+1 QUIT
TXERSUB ;
+1 WRITE !,"LIST OF VISITS WITH TRANSACTION ERRORS"
+2 IF $DATA(APCDDEMM)
WRITE "----MANDATORY DEMOGRAPHIC DATA ITEMS",!,"*******MUST BE CORRECTED IN ORDER FOR DATA TO BE TRANSMITTED*******"
+3 IF $DATA(APCDDEM)
WRITE "----DEMOGRAPHIC ERRORS (PAT REG)"
+4 QUIT
MRGSUB ;
+1 WRITE !,"MULTIPLE VISITS ON ONE DAY;POTENTIAL MERGES"
+2 QUIT
INPTSUB ;
+1 WRITE !,"VISITS WITH INPATIENT EDIT ERRORS"
+2 QUIT
PAGEHEAD ;
HEAD ;EP;HEADER
+1 IF $DATA(APCDDEM)!($DATA(APCDDEMM))
GOTO HEAD2
+2 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 !,APCDDT,?70,"Page: ",APCDPG
+3 WRITE !?29,"PCC Data Entry Module"
+4 WRITE !?23,"*********************************"
+5 WRITE !?23,"* VISIT REVIEW ERROR REPORT *"
+6 WRITE !?23,"*********************************"
+7 WRITE !!,"Report of Errors for ",$SELECT(APCDPROC="P":"Posting",APCDPROC="V":"VISIT",1:"Posting")," Date Range: ",APCDBDD," through ",APCDEDD
+8 SET X=$SELECT(APCDLOCT="A":"ALL Locations Included",APCDLOCT="O":"Location of Encounter: "_$PIECE(^DIC(4,APCDLOCT("ONE"),0),U),APCDLOCT="S":"LOCATIONs Included: ALL Within the "_$PIECE(^AUTTSU(APCDLOCT("SU"),0),U)_" Service Unit",1:"")
+9 WRITE !?(80-$LENGTH(X)/2),X
+10 WRITE !,APCD80S
+11 DO @(APCDT_"SUB")
+12 WRITE !,APCD80S
+13 QUIT
