APCDCHKP ; IHS/CMI/LAB - I-LINK REPORT ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;IHS/ANMC/LJF 8/4/97 modified for ANMC use
;
U IO
S APCDPG=0,%DT="",X="T" D ^%DT X ^DD("DD") S APCDDT=Y
HIT ; Write report of In-hospital visits that were linked
S APCDT="HIT"
D HEAD I '$D(^XTMP("ILINK",$J,"HIT")) W !!,"NO In-Hospital Visits were linked to Hospitalizations during this run." G NO
S APCDH="" F S APCDH=$O(^XTMP("ILINK",$J,"HIT",APCDH)) Q:APCDH'=+APCDH D:$Y>(IOSL-8) HEAD W !!,"HOSPITAL:" D PRNH,HIT2
NO ;
S APCDT="NO"
G:'$D(^XTMP("ILINK",$J,"NOHIT")) OLD
D HEAD S APCDI="" F S APCDI=$O(^XTMP("ILINK",$J,"NOHIT",APCDI)) Q:APCDI'=+APCDI D:$Y>(IOSL-6) HEAD W ! D PRNI
OLD ;
S APCDT="OLD"
G:'$D(^XTMP("ILINK",$J,"ONEYR")) MULT
D HEAD S APCDI="" F S APCDI=$O(^XTMP("ILINK",$J,"ONEYR",APCDI)) Q:APCDI'=+APCDI D:$Y>(IOSL-6) HEAD W ! D PRNI
MULT ;
S APCDT="MULT"
D HEAD S APCDI=0 F S APCDI=$O(^XTMP("ILINK",$J,"TWOHITS",APCDI)) Q:APCDI'=+APCDI D:$Y>(IOSL-8) HEAD W ! D PRNI,GETHOSP
I '$D(^XTMP("ILINK",$J,"TWOHITS")) W !,"NO PROBLEMS",!
PROC ; print deleted procedures
S APCDT="PROC"
Q:'$D(^XTMP("ILINK",$J,"PROC ERROR"))
D HEAD^APCDCHKP S APCDI="" F S APCDI=$O(^XTMP("ILINK",$J,"PROC ERROR",APCDI)) Q:APCDI="" S APCDPDFN=^XTMP("ILINK",$J,"PROC ERROR",APCDI) D:$Y>(IOSL-6) HEAD^APCDCHKP D PRNP
EOJ ;
W:$D(IOF) @IOF
K APCDIV,APCDRD,APCDHV,APCDH,APCDV,APCDI,APCDDCD,APCDHV,APCDRD
K X,Y,APCDPG,APCDT
Q
PRNP ;
S APCDIV=^AUPNVSIT($P(APCDPDFN,U,3),0) S:'$P(APCDIV,U,6) $P(APCDIV,U,6)=0
S Y=+APCDIV X ^DD("DD") S APCDRD=Y
W !,"IN-HOSP: DATE: [",APCDRD,"] NAME: [",$P(^DPT($P(APCDIV,U,5),0),U),"] TYPE: [",$P(APCDIV,U,3),"]"
W !," LOCATION: [",$S($D(^DIC(4,$P(APCDIV,U,6),0)):$P(^(0),U),1:"UNKNOWN"),"] DEPENDENT ENTRY CNT: [",$P(APCDIV,U,9),"]"
;W !?10,"Procedure: ",$P(^ICD0($P(APCDPDFN,U),0),U),?30,"Provider Narr: ",$P(^AUTNPOV($P(APCDPDFN,U,4),0),U)
W !?10,"Procedure: ",$P($$ICDOP^ICDEX($P(APCDPDFN,U),$$VD^APCLV($P(APCDPDFN,U,3)),,"I"),U,2),?30,"Provider Narr: ",$P(^AUTNPOV($P(APCDPDFN,U,4),0),U)
Q
PRNH ;
S APCDHV=^AUPNVSIT(APCDH,0) S:'$P(APCDHV,U,6) $P(APCDHV,U,6)=0 S APCDTYPE=$P(APCDHV,U,3)
S APCDINPD=0
I APCDTYPE="C" S APCDINPD=$O(^AUPNVCHS("AD",APCDH,APCDINPD)) I APCDINPD]"" S APCDDCD=$P(^AUPNVCHS(APCDINPD,0),U,7)
I APCDTYPE'="C" S APCDINPD=$O(^AUPNVINP("AD",APCDH,APCDINPD)) I APCDINPD]"" S APCDDCD=$P(^AUPNVINP(APCDINPD,0),U)
S:APCDDCD]"" Y=APCDDCD X ^DD("DD") S APCDDCD=Y
S Y=+APCDHV X ^DD("DD") S APCDRD=Y
W " DATE: [",APCDRD,"] NAME: [",$P(^DPT($P(APCDHV,U,5),0),U),"] TYPE: [",$P(APCDHV,U,3),"]"
W !," LOCATION: [",$S($D(^DIC(4,$P(APCDHV,U,6),0)):$P(^(0),U),1:"UNKNOWN"),"] DISCH DATE: [",APCDDCD,"]"
Q
PRNI ;
S APCDIV=^AUPNVSIT(APCDI,0) S:'$P(APCDIV,U,6) $P(APCDIV,U,6)=0
S Y=+APCDIV X ^DD("DD") S APCDRD=Y
W !,"IN-HOSP: DATE: [",APCDRD,"] NAME: [",$P(^DPT($P(APCDIV,U,5),0),U),"] TYPE: [",$P(APCDIV,U,3),"]"
W !," LOCATION: [",$S($D(^DIC(4,$P(APCDIV,U,6),0)):$P(^(0),U),1:"UNKNOWN"),"] DEPENDENT ENTRY CNT: [",$P(APCDIV,U,9),"]"
Q
HIT2 S APCDI="" F S APCDI=$O(^XTMP("ILINK",$J,"HIT",APCDH,APCDI)) Q:APCDI'=+APCDI D:$Y>(IOSL-4) HEAD D PRNI
Q
MULTSUB ;
W !,"The following In-Hospital Visits could be linked to two or more ",!,"Hospitalizations. They must be linked manually."
Q
GETHOSP ;
S APCDH=0 F S APCDH=$O(^XTMP("ILINK",$J,"TWOHITS",APCDI,APCDH)) Q:APCDH'=+APCDH W !,"HOSPITALIZATION:" D PRNH
Q
HEAD ;EP;HEADER
I 'APCDPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!($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 !?9,"*************************************************************"
W !?9,"* REPORT OF IN-HOSPITAL VISITS LINKED TO HOSPITALIZATIONS *"
W !?9,"*************************************************************"
S X="",$P(X,"-",80)="" W !!,X
D @(APCDT_"SUB")
W !,X
Q
NOSUB ;
W !,"In-Hospital Visits that remain NOT linked to a Hospitalization"
Q
OLDSUB ;
W !,"The following List of IN-HOSPITAL Visits are over one year old and are",!,"not linked to a Hospitalization. These visits will not be displayed on",!,"future reports."
Q
HITSUB ; Sub heading for Linked visit report
W !,"The following In-Hospital Visits were linked to the Hospitalization listed"
Q
;
PROCSUB ;
W !,"Because they were duplicates, the following V Procedure Records were deleted",!,"from the IN-HOSPITAL record displayed."
Q
APCDCHKP ; IHS/CMI/LAB - I-LINK REPORT ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;IHS/ANMC/LJF 8/4/97 modified for ANMC use
+3 ;
+4 USE IO
+5 SET APCDPG=0
SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET APCDDT=Y
HIT ; Write report of In-hospital visits that were linked
+1 SET APCDT="HIT"
+2 DO HEAD
IF '$DATA(^XTMP("ILINK",$JOB,"HIT"))
WRITE !!,"NO In-Hospital Visits were linked to Hospitalizations during this run."
GOTO NO
+3 SET APCDH=""
FOR
SET APCDH=$ORDER(^XTMP("ILINK",$JOB,"HIT",APCDH))
IF APCDH'=+APCDH
QUIT
IF $Y>(IOSL-8)
DO HEAD
WRITE !!,"HOSPITAL:"
DO PRNH
DO HIT2
NO ;
+1 SET APCDT="NO"
+2 IF '$DATA(^XTMP("ILINK",$JOB,"NOHIT"))
GOTO OLD
+3 DO HEAD
SET APCDI=""
FOR
SET APCDI=$ORDER(^XTMP("ILINK",$JOB,"NOHIT",APCDI))
IF APCDI'=+APCDI
QUIT
IF $Y>(IOSL-6)
DO HEAD
WRITE !
DO PRNI
OLD ;
+1 SET APCDT="OLD"
+2 IF '$DATA(^XTMP("ILINK",$JOB,"ONEYR"))
GOTO MULT
+3 DO HEAD
SET APCDI=""
FOR
SET APCDI=$ORDER(^XTMP("ILINK",$JOB,"ONEYR",APCDI))
IF APCDI'=+APCDI
QUIT
IF $Y>(IOSL-6)
DO HEAD
WRITE !
DO PRNI
MULT ;
+1 SET APCDT="MULT"
+2 DO HEAD
SET APCDI=0
FOR
SET APCDI=$ORDER(^XTMP("ILINK",$JOB,"TWOHITS",APCDI))
IF APCDI'=+APCDI
QUIT
IF $Y>(IOSL-8)
DO HEAD
WRITE !
DO PRNI
DO GETHOSP
+3 IF '$DATA(^XTMP("ILINK",$JOB,"TWOHITS"))
WRITE !,"NO PROBLEMS",!
PROC ; print deleted procedures
+1 SET APCDT="PROC"
+2 IF '$DATA(^XTMP("ILINK",$JOB,"PROC ERROR"))
QUIT
+3 DO HEAD^APCDCHKP
SET APCDI=""
FOR
SET APCDI=$ORDER(^XTMP("ILINK",$JOB,"PROC ERROR",APCDI))
IF APCDI=""
QUIT
SET APCDPDFN=^XTMP("ILINK",$JOB,"PROC ERROR",APCDI)
IF $Y>(IOSL-6)
DO HEAD^APCDCHKP
DO PRNP
EOJ ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL APCDIV,APCDRD,APCDHV,APCDH,APCDV,APCDI,APCDDCD,APCDHV,APCDRD
+3 KILL X,Y,APCDPG,APCDT
+4 QUIT
PRNP ;
+1 SET APCDIV=^AUPNVSIT($PIECE(APCDPDFN,U,3),0)
IF '$PIECE(APCDIV,U,6)
SET $PIECE(APCDIV,U,6)=0
+2 SET Y=+APCDIV
XECUTE ^DD("DD")
SET APCDRD=Y
+3 WRITE !,"IN-HOSP: DATE: [",APCDRD,"] NAME: [",$PIECE(^DPT($PIECE(APCDIV,U,5),0),U),"] TYPE: [",$PIECE(APCDIV,U,3),"]"
+4 WRITE !," LOCATION: [",$SELECT($DATA(^DIC(4,$PIECE(APCDIV,U,6),0)):$PIECE(^(0),U),1:"UNKNOWN"),"] DEPENDENT ENTRY CNT: [",$PIECE(APCDIV,U,9),"]"
+5 ;W !?10,"Procedure: ",$P(^ICD0($P(APCDPDFN,U),0),U),?30,"Provider Narr: ",$P(^AUTNPOV($P(APCDPDFN,U,4),0),U)
+6 WRITE !?10,"Procedure: ",$PIECE($$ICDOP^ICDEX($PIECE(APCDPDFN,U),$$VD^APCLV($PIECE(APCDPDFN,U,3)),,"I"),U,2),?30,"Provider Narr: ",$PIECE(^AUTNPOV($PIECE(APCDPDFN,U,4),0),U)
+7 QUIT
PRNH ;
+1 SET APCDHV=^AUPNVSIT(APCDH,0)
IF '$PIECE(APCDHV,U,6)
SET $PIECE(APCDHV,U,6)=0
SET APCDTYPE=$PIECE(APCDHV,U,3)
+2 SET APCDINPD=0
+3 IF APCDTYPE="C"
SET APCDINPD=$ORDER(^AUPNVCHS("AD",APCDH,APCDINPD))
IF APCDINPD]""
SET APCDDCD=$PIECE(^AUPNVCHS(APCDINPD,0),U,7)
+4 IF APCDTYPE'="C"
SET APCDINPD=$ORDER(^AUPNVINP("AD",APCDH,APCDINPD))
IF APCDINPD]""
SET APCDDCD=$PIECE(^AUPNVINP(APCDINPD,0),U)
+5 IF APCDDCD]""
SET Y=APCDDCD
XECUTE ^DD("DD")
SET APCDDCD=Y
+6 SET Y=+APCDHV
XECUTE ^DD("DD")
SET APCDRD=Y
+7 WRITE " DATE: [",APCDRD,"] NAME: [",$PIECE(^DPT($PIECE(APCDHV,U,5),0),U),"] TYPE: [",$PIECE(APCDHV,U,3),"]"
+8 WRITE !," LOCATION: [",$SELECT($DATA(^DIC(4,$PIECE(APCDHV,U,6),0)):$PIECE(^(0),U),1:"UNKNOWN"),"] DISCH DATE: [",APCDDCD,"]"
+9 QUIT
PRNI ;
+1 SET APCDIV=^AUPNVSIT(APCDI,0)
IF '$PIECE(APCDIV,U,6)
SET $PIECE(APCDIV,U,6)=0
+2 SET Y=+APCDIV
XECUTE ^DD("DD")
SET APCDRD=Y
+3 WRITE !,"IN-HOSP: DATE: [",APCDRD,"] NAME: [",$PIECE(^DPT($PIECE(APCDIV,U,5),0),U),"] TYPE: [",$PIECE(APCDIV,U,3),"]"
+4 WRITE !," LOCATION: [",$SELECT($DATA(^DIC(4,$PIECE(APCDIV,U,6),0)):$PIECE(^(0),U),1:"UNKNOWN"),"] DEPENDENT ENTRY CNT: [",$PIECE(APCDIV,U,9),"]"
+5 QUIT
HIT2 SET APCDI=""
FOR
SET APCDI=$ORDER(^XTMP("ILINK",$JOB,"HIT",APCDH,APCDI))
IF APCDI'=+APCDI
QUIT
IF $Y>(IOSL-4)
DO HEAD
DO PRNI
+1 QUIT
MULTSUB ;
+1 WRITE !,"The following In-Hospital Visits could be linked to two or more ",!,"Hospitalizations. They must be linked manually."
+2 QUIT
GETHOSP ;
+1 SET APCDH=0
FOR
SET APCDH=$ORDER(^XTMP("ILINK",$JOB,"TWOHITS",APCDI,APCDH))
IF APCDH'=+APCDH
QUIT
WRITE !,"HOSPITALIZATION:"
DO PRNH
+2 QUIT
HEAD ;EP;HEADER
+1 IF 'APCDPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!($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 !?9,"*************************************************************"
+5 WRITE !?9,"* REPORT OF IN-HOSPITAL VISITS LINKED TO HOSPITALIZATIONS *"
+6 WRITE !?9,"*************************************************************"
+7 SET X=""
SET $PIECE(X,"-",80)=""
WRITE !!,X
+8 DO @(APCDT_"SUB")
+9 WRITE !,X
+10 QUIT
NOSUB ;
+1 WRITE !,"In-Hospital Visits that remain NOT linked to a Hospitalization"
+2 QUIT
OLDSUB ;
+1 WRITE !,"The following List of IN-HOSPITAL Visits are over one year old and are",!,"not linked to a Hospitalization. These visits will not be displayed on",!,"future reports."
+2 QUIT
HITSUB ; Sub heading for Linked visit report
+1 WRITE !,"The following In-Hospital Visits were linked to the Hospitalization listed"
+2 QUIT
+3 ;
PROCSUB ;
+1 WRITE !,"Because they were duplicates, the following V Procedure Records were deleted",!,"from the IN-HOSPITAL record displayed."
+2 QUIT
