APCDDVW1 ; IHS/CMI/LAB - Print Hosp. review report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
ZERO ;EP;Write zero dependent report
D HEAD^APCDDVW
W !!,"TOTAL NUMBER OF ERRORS ON THIS ZERO DEPENDENT ENTRY REPORT: ",$G(APCDCNTR("ZERO")),!!
I '$D(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO")) W !!,"There are no Visits with a Zero Dependent Entry Count on or ",!,"after ",$S(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date " S Y=APCDBD D DT^DIO2 S Y="" Q
S APCDCL=0 F S APCDCL=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL)) Q:APCDCL'=+APCDCL!($D(APCDQUIT)) S APCDCLIN="" F S APCDCLIN=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL,APCDCLIN)) Q:APCDCLIN=""!($D(APCDQUIT)) D
.S APCDH="" F S APCDH=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL,APCDCLIN,APCDH)) Q:APCDH=""!($D(APCDQUIT)) D
..S APCDV=0 F S APCDV=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL,APCDCLIN,APCDH,APCDV)) Q:APCDV'=+APCDV!($D(APCDQUIT)) D:$Y>(IOSL-4) HEAD^APCDDVW Q:$D(APCDQUIT) D PRN1^APCDDVW
Q
MRG ;EP;print potential merges
D HEAD^APCDDVW
W !!,"TOTAL NUMBER OF POTENTIAL MERGES ON THIS REPORT: ",$G(APCDCNTR("MRG")),!!
I '$D(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG")) W !!,"There are no visits in the specified ",$S(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date range that should be merged." Q
MRG2 ;
S APCDCL=0 F S APCDCL=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL)) Q:APCDCL'=+APCDCL!($D(APCDQUIT)) S APCDCLIN="" F S APCDCLIN=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN)) Q:APCDCLIN=""!($D(APCDQUIT)) D
.S APCDH="" F S APCDH=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN,APCDH)) Q:APCDH=""!($D(APCDQUIT)) D
..S APCDVSIT=0 F S APCDVSIT=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN,APCDH,APCDVSIT)) Q:APCDVSIT="" Q:$D(APCDQUIT) D MRG3
Q
MRG3 ;
S APCDV=0 F S APCDV=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN,APCDH,APCDVSIT,APCDV)) Q:APCDV="" D:$Y>(IOSL-7) HEAD^APCDDVW Q:$D(APCDQUIT) D PRN1^APCDDVW
Q
INPT ;EP;print inpatient errors
D HEAD^APCDDVW
W !!,"TOTAL NUMBER OF ERRORS ON THIS INPT REPORT: ",$G(APCDCNTR("INPT")),!!
I '$D(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT")) W !!,"There are no Hospitalization visits in the specified ",$S(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date range ",!,"that have Errors." Q
S APCDCL=0 F S APCDCL=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL)) Q:APCDCL'=+APCDCL!($D(APCDQUIT)) S APCDCLIN="" F S APCDCLIN=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN)) Q:APCDCLIN=""!($D(APCDQUIT)) D
.S APCDH="" F S APCDH=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH)) Q:APCDH=""!($D(APCDQUIT)) D
..S APCDV=0 F S APCDV=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH,APCDV)) Q:APCDV'=+APCDV!($D(APCDQUIT)) D:$Y>(IOSL-7) HEAD^APCDDVW Q:$D(APCDQUIT) D PRN1^APCDDVW W !?20,"ERROR INFORMATION" D INPT2
D XIT
Q
INPT2 S APCDE="" F S APCDE=$O(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH,APCDV,APCDE)) Q:APCDE="" D INPTW
Q
INPTW W !," Error #",APCDE,": ",^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH,APCDV,APCDE)
Q
DISPPP ;EP display primary provider
NEW X,Y S X=0 F S X=$O(^AUPNVPRV("AD",APCDV,X)) Q:X'=+X I $P(^AUPNVPRV(X,0),U,4)="P" W ?30,"PRIMARY PROVIDER: [",$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,$P(^AUPNVPRV(X,0),U),0),U),1:$P(^DIC(16,$P(^AUPNVPRV(X,0),U),0),U)),"]"
Q
XIT ; Clean up and exit
K APCDDT,APCDLC,APCDV,APCDBS,APCDV2,APCDL,APCDE,APCDEDFN,APCDVR,APCDRD,DFN,APCDH,APCDDEM
Q
APCDDVW1 ; IHS/CMI/LAB - Print Hosp. review report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
ZERO ;EP;Write zero dependent report
+1 DO HEAD^APCDDVW
+2 WRITE !!,"TOTAL NUMBER OF ERRORS ON THIS ZERO DEPENDENT ENTRY REPORT: ",$GET(APCDCNTR("ZERO")),!!
+3 IF '$DATA(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO"))
WRITE !!,"There are no Visits with a Zero Dependent Entry Count on or ",!,"after ",$SELECT(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date "
SET Y=APCDBD
DO DT^DIO2
SET Y=""
QUIT
+4 SET APCDCL=0
FOR
SET APCDCL=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL))
IF APCDCL'=+APCDCL!($DATA(APCDQUIT))
QUIT
SET APCDCLIN=""
FOR
SET APCDCLIN=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL,APCDCLIN))
IF APCDCLIN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+5 SET APCDH=""
FOR
SET APCDH=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL,APCDCLIN,APCDH))
IF APCDH=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+6 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"ZERO",APCDCL,APCDCLIN,APCDH,APCDV))
IF APCDV'=+APCDV!($DATA(APCDQUIT))
QUIT
IF $Y>(IOSL-4)
DO HEAD^APCDDVW
IF $DATA(APCDQUIT)
QUIT
DO PRN1^APCDDVW
End DoDot:2
End DoDot:1
+7 QUIT
MRG ;EP;print potential merges
+1 DO HEAD^APCDDVW
+2 WRITE !!,"TOTAL NUMBER OF POTENTIAL MERGES ON THIS REPORT: ",$GET(APCDCNTR("MRG")),!!
+3 IF '$DATA(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG"))
WRITE !!,"There are no visits in the specified ",$SELECT(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date range that should be merged."
QUIT
MRG2 ;
+1 SET APCDCL=0
FOR
SET APCDCL=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL))
IF APCDCL'=+APCDCL!($DATA(APCDQUIT))
QUIT
SET APCDCLIN=""
FOR
SET APCDCLIN=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN))
IF APCDCLIN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+2 SET APCDH=""
FOR
SET APCDH=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN,APCDH))
IF APCDH=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+3 SET APCDVSIT=0
FOR
SET APCDVSIT=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN,APCDH,APCDVSIT))
IF APCDVSIT=""
QUIT
IF $DATA(APCDQUIT)
QUIT
DO MRG3
End DoDot:2
End DoDot:1
+4 QUIT
MRG3 ;
+1 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"MRG",APCDCL,APCDCLIN,APCDH,APCDVSIT,APCDV))
IF APCDV=""
QUIT
IF $Y>(IOSL-7)
DO HEAD^APCDDVW
IF $DATA(APCDQUIT)
QUIT
DO PRN1^APCDDVW
+2 QUIT
INPT ;EP;print inpatient errors
+1 DO HEAD^APCDDVW
+2 WRITE !!,"TOTAL NUMBER OF ERRORS ON THIS INPT REPORT: ",$GET(APCDCNTR("INPT")),!!
+3 IF '$DATA(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT"))
WRITE !!,"There are no Hospitalization visits in the specified ",$SELECT(APCDPROC="P":"Posting",APCDPROC="V":"Visit",1:"Posting")," date range ",!,"that have Errors."
QUIT
+4 SET APCDCL=0
FOR
SET APCDCL=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL))
IF APCDCL'=+APCDCL!($DATA(APCDQUIT))
QUIT
SET APCDCLIN=""
FOR
SET APCDCLIN=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN))
IF APCDCLIN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+5 SET APCDH=""
FOR
SET APCDH=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH))
IF APCDH=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+6 SET APCDV=0
FOR
SET APCDV=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH,APCDV))
IF APCDV'=+APCDV!($DATA(APCDQUIT))
QUIT
IF $Y>(IOSL-7)
DO HEAD^APCDDVW
IF $DATA(APCDQUIT)
QUIT
DO PRN1^APCDDVW
WRITE !?20,"ERROR INFORMATION"
DO INPT2
End DoDot:2
End DoDot:1
+7 DO XIT
+8 QUIT
INPT2 SET APCDE=""
FOR
SET APCDE=$ORDER(^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH,APCDV,APCDE))
IF APCDE=""
QUIT
DO INPTW
+1 QUIT
INPTW WRITE !," Error #",APCDE,": ",^XTMP("APCDDV",APCDJOB,APCDBT,"INPT",APCDCL,APCDCLIN,APCDH,APCDV,APCDE)
+1 QUIT
DISPPP ;EP display primary provider
+1 NEW X,Y
SET X=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",APCDV,X))
IF X'=+X
QUIT
IF $PIECE(^AUPNVPRV(X,0),U,4)="P"
WRITE ?30,"PRIMARY PROVIDER: [",$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,$PIECE(^AUPNVPRV(X,0),U),0),U),1:$PIECE(^DIC(16,$PIECE(^AUPNVPRV(X,0),U),0),U)),"]"
+2 QUIT
XIT ; Clean up and exit
+1 KILL APCDDT,APCDLC,APCDV,APCDBS,APCDV2,APCDL,APCDE,APCDEDFN,APCDVR,APCDRD,DFN,APCDH,APCDDEM
+2 QUIT
