APCDCHKP.m

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