APCDCHP1.m

APCDCHP1 ; IHS/CMI/LAB - CONT. PRINT LINK ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;

 ;

PROC ; ENTRY POINT;print deleted procedures

 S APCDT="PROC"

 Q:'$D(^TMP("ILINK",$J,"PROC ERROR"))

 D HEAD^APCDCHKP S APCDI="" F  S APCDI=$O(^TMP("ILINK",$J,"PROC ERROR",APCDI)) Q:APCDI=""  S APCDPDFN=^TMP("ILINK",$J,"PROC ERROR",APCDI) D:$Y>(IOSL-6) HEAD^APCDCHKP D PRNP

 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($$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

APCDCHP1  ; IHS/CMI/LAB - CONT. PRINT LINK ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +2       ;

 +3       ;

PROC      ; ENTRY POINT;print deleted procedures

 +1        SET APCDT="PROC"

 +2        IF '$DATA(^TMP("ILINK",$JOB,"PROC ERROR"))

               QUIT 

 +3        DO HEAD^APCDCHKP

           SET APCDI=""

           FOR 

               SET APCDI=$ORDER(^TMP("ILINK",$JOB,"PROC ERROR",APCDI))

               IF APCDI=""

                   QUIT 

               SET APCDPDFN=^TMP("ILINK",$JOB,"PROC ERROR",APCDI)

               IF $Y>(IOSL-6)

                   DO HEAD^APCDCHKP

               DO PRNP

 +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        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)

 +6        QUIT