APCPHOS1 ; IHS/TUCSON/LAB - REVIEW HOSPITALIZATIONS - CONT. AUGUST 14, 1992 ; [ 09/08/99 7:41 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**3**;APR 03, 1998
;
START ;
CHKDXOP ; CHECK DX VS OPERATIONS AND CHECK FOR DUPLICATE POVS
K APCPDUPE,APCPPOVS,APCPHDXP S APCPDX=0 F S APCPDX=$O(^AUPNVPOV("AD",APCP("V DFN"),APCPDX)) Q:APCPDX=""!($D(APCPE)) S APCPPOVS(APCPDX)="" D CHKDXOP1
K APCPDUPO,APCPVPRC,APCPOPP
I $D(APCPE) G XIT
S APCPOPX=0 F S APCPOPX=$O(^AUPNVPRC("AD",APCP("V DFN"),APCPOPX)) Q:APCPOPX=""!$D(APCPE) D CHKDXOP2
G:$D(APCPE) XIT
I $D(APCPDUPE),'$D(APCPV("ACC")) D DUPE G XIT
I $D(APCPDUPO),'$D(APCPV("ACC")) D DUPEOP G XIT
D C567
XIT ;
K APCP1,APCP2,APCPDX,APCPOPX,APCPODX,APCPDUPE,APCPDUPO,APCPHDXP,APCPOPP,APCPHIT,APCPOPC,APCPPR,APCPPRC,APCPVPRC,APCPPOVS,APCPOPC
Q
CHKDXOP1 ;
I $D(APCPHDXP($P(^AUPNVPOV(APCPDX,0),U))) S APCPDUPE=1
S APCPHDXP($P(^AUPNVPOV(APCPDX,0),U))=""
Q
CHKDXOP2 ;
S APCPODX=$P(^AUPNVPRC(APCPOPX,0),U,5) S:APCPODX]"" APCPVPRC(APCPOPX)=APCPODX_"^"_$P(^ICD9(APCPODX,0),U)
I APCPODX="" S APCPE("EDFN")=APCPOPX,APCPE("FILE")=9000010.08,APCPE("ERROR")="E044" Q
I $D(APCPOPP($P(^AUPNVPRC(APCPOPX,0),U))) S APCPDUPO=1
S APCPOPP($P(^AUPNVPRC(APCPOPX,0),U))=""
K APCPHIT F S APCPDX=$O(APCPHDXP(APCPDX)) Q:APCPDX="" I APCPDX=APCPODX S APCPHIT=1
;I '$D(APCPHIT) S APCPE("FILE")=9000010,APCPE("EDFN")=APCP("V DFN"),APCPE("ERROR")="E314" Q ;IHS/CMI/LAB - commented out
Q
DUPE ;
S APCPE("FILE")=9000010,APCPE("EDFN")=APCP("V DFN"),APCPE("ERROR")="E315" Q
Q
DUPEOP ;WARNING RE: DUPLICATE OPERATIONS USED - ACCEPT REQUIRED
S APCPE("FILE")=9000010,APCPE("EDFN")=APCP("V DFN"),APCPE("ERROR")="E316" Q
Q
;
C567 ;CHK DX VS OPS
S APCP1=0 F S APCP1=$O(APCPVPRC(APCP1)) Q:APCP1=""!$D(APCPE) S APCP2=$P(APCPVPRC(APCP1),U,2),APCPOPC=$P(^ICD0($P(^AUPNVPRC(APCP1,0),U),0),U) D
.I $D(^APCDINPT(5,11,"AC",APCP2)),'$D(^APCDINPT(5,12,"AC",APCPOPC)) S APCPE("ERROR")="E317",APCPE("EDFN")=APCP1,APCPE("FILE")=9000010.08
.I $D(^APCDINPT(6,11,"AC",APCP2)),'$D(^APCDINPT(6,12,"AC",APCPOPC)) S APCPE("ERROR")="E317",APCPE("EDFN")=APCP1,APCPE("FILE")=9000010.08
.I $D(^APCDINPT(7,11,"AC",APCP2)),'$D(^APCDINPT(7,12,"AC",APCPOPC)) S APCPE("ERROR")="E317",APCPE("EDFN")=APCP1,APCPE("FILE")=9000010.08
Q:$D(APCPE)
S APCP1=0 F S APCP1=$O(APCPPOVS(APCP1)) Q:APCP1="" S APCPDX=$P(^AUPNVPOV(APCP1,0),U) I $D(^APCDINPT(6,11,"AC",$P(^ICD9(APCPDX,0),U))) D C6ERR
Q
C6ERR ;
I '$D(APCPVPRC) S APCPE("ERROR")="E333",APCPE("FILE")=9000010,APCPE("EDFN")=APCP("V DFN") Q
K APCPHIT S APCP2=0 F S APCP2=$O(APCPVPRC(APCP2)) Q:APCP2="" S APCPOPC=$P(^ICD0($P(^AUPNVPRC(APCP2,0),U),0),U) I $D(^APCDINPT(6,12,"AC",APCPOPC)),$P(APCPVPRC(APCP2),U)=APCPDX S APCPHIT=1
I '$D(APCPHIT) S APCPE("ERROR")="E333",APCPE("FILE")=9000010,APCPE("EDFN")=APCP("V DFN")
Q
APCPHOS1 ; IHS/TUCSON/LAB - REVIEW HOSPITALIZATIONS - CONT. AUGUST 14, 1992 ; [ 09/08/99 7:41 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**3**;APR 03, 1998
+2 ;
START ;
CHKDXOP ; CHECK DX VS OPERATIONS AND CHECK FOR DUPLICATE POVS
+1 KILL APCPDUPE,APCPPOVS,APCPHDXP
SET APCPDX=0
FOR
SET APCPDX=$ORDER(^AUPNVPOV("AD",APCP("V DFN"),APCPDX))
IF APCPDX=""!($DATA(APCPE))
QUIT
SET APCPPOVS(APCPDX)=""
DO CHKDXOP1
+2 KILL APCPDUPO,APCPVPRC,APCPOPP
+3 IF $DATA(APCPE)
GOTO XIT
+4 SET APCPOPX=0
FOR
SET APCPOPX=$ORDER(^AUPNVPRC("AD",APCP("V DFN"),APCPOPX))
IF APCPOPX=""!$DATA(APCPE)
QUIT
DO CHKDXOP2
+5 IF $DATA(APCPE)
GOTO XIT
+6 IF $DATA(APCPDUPE)
IF '$DATA(APCPV("ACC"))
DO DUPE
GOTO XIT
+7 IF $DATA(APCPDUPO)
IF '$DATA(APCPV("ACC"))
DO DUPEOP
GOTO XIT
+8 DO C567
XIT ;
+1 KILL APCP1,APCP2,APCPDX,APCPOPX,APCPODX,APCPDUPE,APCPDUPO,APCPHDXP,APCPOPP,APCPHIT,APCPOPC,APCPPR,APCPPRC,APCPVPRC,APCPPOVS,APCPOPC
+2 QUIT
CHKDXOP1 ;
+1 IF $DATA(APCPHDXP($PIECE(^AUPNVPOV(APCPDX,0),U)))
SET APCPDUPE=1
+2 SET APCPHDXP($PIECE(^AUPNVPOV(APCPDX,0),U))=""
+3 QUIT
CHKDXOP2 ;
+1 SET APCPODX=$PIECE(^AUPNVPRC(APCPOPX,0),U,5)
IF APCPODX]""
SET APCPVPRC(APCPOPX)=APCPODX_"^"_$PIECE(^ICD9(APCPODX,0),U)
+2 IF APCPODX=""
SET APCPE("EDFN")=APCPOPX
SET APCPE("FILE")=9000010.08
SET APCPE("ERROR")="E044"
QUIT
+3 IF $DATA(APCPOPP($PIECE(^AUPNVPRC(APCPOPX,0),U)))
SET APCPDUPO=1
+4 SET APCPOPP($PIECE(^AUPNVPRC(APCPOPX,0),U))=""
+5 KILL APCPHIT
FOR
SET APCPDX=$ORDER(APCPHDXP(APCPDX))
IF APCPDX=""
QUIT
IF APCPDX=APCPODX
SET APCPHIT=1
+6 ;I '$D(APCPHIT) S APCPE("FILE")=9000010,APCPE("EDFN")=APCP("V DFN"),APCPE("ERROR")="E314" Q ;IHS/CMI/LAB - commented out
+7 QUIT
DUPE ;
+1 SET APCPE("FILE")=9000010
SET APCPE("EDFN")=APCP("V DFN")
SET APCPE("ERROR")="E315"
QUIT
+2 QUIT
DUPEOP ;WARNING RE: DUPLICATE OPERATIONS USED - ACCEPT REQUIRED
+1 SET APCPE("FILE")=9000010
SET APCPE("EDFN")=APCP("V DFN")
SET APCPE("ERROR")="E316"
QUIT
+2 QUIT
+3 ;
C567 ;CHK DX VS OPS
+1 SET APCP1=0
FOR
SET APCP1=$ORDER(APCPVPRC(APCP1))
IF APCP1=""!$DATA(APCPE)
QUIT
SET APCP2=$PIECE(APCPVPRC(APCP1),U,2)
SET APCPOPC=$PIECE(^ICD0($PIECE(^AUPNVPRC(APCP1,0),U),0),U)
Begin DoDot:1
+2 IF $DATA(^APCDINPT(5,11,"AC",APCP2))
IF '$DATA(^APCDINPT(5,12,"AC",APCPOPC))
SET APCPE("ERROR")="E317"
SET APCPE("EDFN")=APCP1
SET APCPE("FILE")=9000010.08
+3 IF $DATA(^APCDINPT(6,11,"AC",APCP2))
IF '$DATA(^APCDINPT(6,12,"AC",APCPOPC))
SET APCPE("ERROR")="E317"
SET APCPE("EDFN")=APCP1
SET APCPE("FILE")=9000010.08
+4 IF $DATA(^APCDINPT(7,11,"AC",APCP2))
IF '$DATA(^APCDINPT(7,12,"AC",APCPOPC))
SET APCPE("ERROR")="E317"
SET APCPE("EDFN")=APCP1
SET APCPE("FILE")=9000010.08
End DoDot:1
+5 IF $DATA(APCPE)
QUIT
+6 SET APCP1=0
FOR
SET APCP1=$ORDER(APCPPOVS(APCP1))
IF APCP1=""
QUIT
SET APCPDX=$PIECE(^AUPNVPOV(APCP1,0),U)
IF $DATA(^APCDINPT(6,11,"AC",$PIECE(^ICD9(APCPDX,0),U)))
DO C6ERR
+7 QUIT
C6ERR ;
+1 IF '$DATA(APCPVPRC)
SET APCPE("ERROR")="E333"
SET APCPE("FILE")=9000010
SET APCPE("EDFN")=APCP("V DFN")
QUIT
+2 KILL APCPHIT
SET APCP2=0
FOR
SET APCP2=$ORDER(APCPVPRC(APCP2))
IF APCP2=""
QUIT
SET APCPOPC=$PIECE(^ICD0($PIECE(^AUPNVPRC(APCP2,0),U),0),U)
IF $DATA(^APCDINPT(6,12,"AC",APCPOPC))
IF $PIECE(APCPVPRC(APCP2),U)=APCPDX
SET APCPHIT=1
+3 IF '$DATA(APCPHIT)
SET APCPE("ERROR")="E333"
SET APCPE("FILE")=9000010
SET APCPE("EDFN")=APCP("V DFN")
+4 QUIT
