APCLAP91 ; IHS/CMI/LAB - Process APC AP9 report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
S APCLBT=$H,APCLJOB=$J
K ^XTMP("APCLAP9",APCLJOB,APCLBT)
D XTMP^APCLOSUT("APCLAP9","PCC - DATA ANALYSIS REPORT")
V ; Run by visit date
S (APCLGRAN,APCLAPC)=0
S APCLSD=APCLSD_".9999" F S APCLSD=$O(^AUPNVSIT("B",APCLSD)) Q:APCLSD=""!((APCLSD\1)>APCLED) D V1
;
XIT ;
S APCLET=$H
Q
V1 ;
S APCLVIEN="" F S APCLVIEN=$O(^AUPNVSIT("B",APCLSD,APCLVIEN)) Q:APCLVIEN'=+APCLVIEN I $D(^AUPNVSIT(APCLVIEN,0)) S APCLVREC=^(0) D PROC
Q
PROC ;
;K APCLSKIP
Q:'$P(APCLVREC,U,9)
Q:$P(APCLVREC,U,11)
I APCLLOC'=$P(APCLVREC,U,6) Q
S DFN=$P(APCLVREC,U,5)
Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO)) ;IHS/CMI/LAB - all demo patients
S APCLGRAN=APCLGRAN+1
S APCLTYPE=$$VAL^XBDIQ1(9000010,APCLVIEN,.03)
S APCLSC=$$VAL^XBDIQ1(9000010,APCLVIEN,.07)
I '$D(^AUPNVPOV("AD",APCLVIEN)) D G P1
.S $P(^(APCLTYPE),U,2)=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"TYPE",APCLTYPE)):$P(^(APCLTYPE),U,2)+1,1:1)
.S $P(^(APCLSC),U,2)=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"SC",APCLSC)):$P(^(APCLSC),U,2)+1,1:1)
I '$D(^AUPNVPRV("AD",APCLVIEN)) D G P1
.S $P(^(APCLTYPE),U,2)=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"TYPE",APCLTYPE)):$P(^(APCLTYPE),U,2)+1,1:1)
.S $P(^(APCLSC),U,2)=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"SC",APCLSC)):$P(^(APCLSC),U,2)+1,1:1)
S $P(^(APCLTYPE),U,1)=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"TYPE",APCLTYPE)):$P(^(APCLTYPE),U,1)+1,1:1)
S $P(^(APCLSC),U,1)=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"SC",APCLSC)):$P(^(APCLSC),U,1)+1,1:1)
P1 ;
I "AOS"'[$P(APCLVREC,U,7) S ^("NONAPCSC")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"NONAPCSC")):^("NONAPCSC")+1,1:1) Q
I "CVS"[$P(APCLVREC,U,3) S ^("NONAPCTYPE")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"NONAPCTYPE")):^("NONAPCTYPE")+1,1:1) Q
S APCLCLIN=$P(APCLVREC,U,8) I APCLCLIN="" S (APCLCLIN,APCLCLN)=25 G PROC1
CHKCL ;
S APCLCLN=$S(APCLCLIN="":"",$D(^DIC(40.7,APCLCLIN,0)):$P(^DIC(40.7,APCLCLIN,0),U,2),1:"")
I APCLCLN="" S APCLCLN=25
I APCLCLN=56,'$D(^AUPNVMED("AD",APCLVIEN)) S ^("DENTAL NO MED")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"DENTAL NO MED")):^("DENTAL NO MED")+1,1:1) Q
I $T(@APCLCLN)]"" S ^("NONAPCCLN")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"NONAPCCLN")):^("NONAPCCLN")+1,1:1) Q
I "AOS"[$P(APCLVREC,U,7),'$D(^AUPNVPOV("AD",APCLVIEN)) S ^("AOS INCOMPLETE")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"AOS INCOMPLETE")):^("AOS INCOMPLETE")+1,1:1) Q
I "AOS"[$P(APCLVREC,U,7),'$D(^AUPNVPRV("AD",APCLVIEN)) S ^("AOS INCOMPLETE")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"AOS INCOMPLETE")):^("AOS INCOMPLETE")+1,1:1) Q
;
PROC1 ;
;TABLE VISITS AND COUNT DUPLICATES BY PATIENT,DATE,CLINIC
;I $D(^XTMP("APCLAP9",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN)) S ^("DUPLICATE")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"DUPLICATE")):^("DUPLICATE")+1,1:1) Q
;E S ^XTMP("APCLAP9",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN)=""
S APCLAPC=APCLAPC+1
I $D(^AUPNVSIT("ADWO",$P(APCLVREC,U,2),APCLVIEN)) S ^("IN XREF")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1) Q
I $D(^AUPNVSIT("ADWO",$P($P(APCLVREC,U,13),"."),APCLVIEN)) S ^("IN XREF")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1) Q
;I $P(APCLVREC,U,14)="" S ^("NO EXPORT - ?")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"NO EXPORT - ?")):^("NO EXPORT - ?")+1,1:1) Q
I $P($G(^AUPNVSIT(APCLVIEN,11)),U,6)="" S ^("NO EXPORT - ?")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"NO EXPORT - ?")):^("NO EXPORT - ?")+1,1:1) Q
Q
;
;
CLEX ;
09 ;;
11 ;;
36 ;;
41 ;;
42 ;;
51 ;;
52 ;;
53 ;;
54 ;;
60 ;;
99 ;;
APCLAP91 ; IHS/CMI/LAB - Process APC AP9 report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
+1 SET APCLBT=$HOROLOG
SET APCLJOB=$JOB
+2 KILL ^XTMP("APCLAP9",APCLJOB,APCLBT)
+3 DO XTMP^APCLOSUT("APCLAP9","PCC - DATA ANALYSIS REPORT")
V ; Run by visit date
+1 SET (APCLGRAN,APCLAPC)=0
+2 SET APCLSD=APCLSD_".9999"
FOR
SET APCLSD=$ORDER(^AUPNVSIT("B",APCLSD))
IF APCLSD=""!((APCLSD\1)>APCLED)
QUIT
DO V1
+3 ;
XIT ;
+1 SET APCLET=$HOROLOG
+2 QUIT
V1 ;
+1 SET APCLVIEN=""
FOR
SET APCLVIEN=$ORDER(^AUPNVSIT("B",APCLSD,APCLVIEN))
IF APCLVIEN'=+APCLVIEN
QUIT
IF $DATA(^AUPNVSIT(APCLVIEN,0))
SET APCLVREC=^(0)
DO PROC
+2 QUIT
PROC ;
+1 ;K APCLSKIP
+2 IF '$PIECE(APCLVREC,U,9)
QUIT
+3 IF $PIECE(APCLVREC,U,11)
QUIT
+4 IF APCLLOC'=$PIECE(APCLVREC,U,6)
QUIT
+5 SET DFN=$PIECE(APCLVREC,U,5)
+6 ;IHS/CMI/LAB - all demo patients
IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+7 SET APCLGRAN=APCLGRAN+1
+8 SET APCLTYPE=$$VAL^XBDIQ1(9000010,APCLVIEN,.03)
+9 SET APCLSC=$$VAL^XBDIQ1(9000010,APCLVIEN,.07)
+10 IF '$DATA(^AUPNVPOV("AD",APCLVIEN))
Begin DoDot:1
+11 SET $PIECE(^(APCLTYPE),U,2)=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"TYPE",APCLTYPE)):$PIECE(^(APCLTYPE),U,2)+1,1:1)
+12 SET $PIECE(^(APCLSC),U,2)=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"SC",APCLSC)):$PIECE(^(APCLSC),U,2)+1,1:1)
End DoDot:1
GOTO P1
+13 IF '$DATA(^AUPNVPRV("AD",APCLVIEN))
Begin DoDot:1
+14 SET $PIECE(^(APCLTYPE),U,2)=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"TYPE",APCLTYPE)):$PIECE(^(APCLTYPE),U,2)+1,1:1)
+15 SET $PIECE(^(APCLSC),U,2)=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"SC",APCLSC)):$PIECE(^(APCLSC),U,2)+1,1:1)
End DoDot:1
GOTO P1
+16 SET $PIECE(^(APCLTYPE),U,1)=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"TYPE",APCLTYPE)):$PIECE(^(APCLTYPE),U,1)+1,1:1)
+17 SET $PIECE(^(APCLSC),U,1)=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"SC",APCLSC)):$PIECE(^(APCLSC),U,1)+1,1:1)
P1 ;
+1 IF "AOS"'[$PIECE(APCLVREC,U,7)
SET ^("NONAPCSC")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"NONAPCSC")):^("NONAPCSC")+1,1:1)
QUIT
+2 IF "CVS"[$PIECE(APCLVREC,U,3)
SET ^("NONAPCTYPE")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"NONAPCTYPE")):^("NONAPCTYPE")+1,1:1)
QUIT
+3 SET APCLCLIN=$PIECE(APCLVREC,U,8)
IF APCLCLIN=""
SET (APCLCLIN,APCLCLN)=25
GOTO PROC1
CHKCL ;
+1 SET APCLCLN=$SELECT(APCLCLIN="":"",$DATA(^DIC(40.7,APCLCLIN,0)):$PIECE(^DIC(40.7,APCLCLIN,0),U,2),1:"")
+2 IF APCLCLN=""
SET APCLCLN=25
+3 IF APCLCLN=56
IF '$DATA(^AUPNVMED("AD",APCLVIEN))
SET ^("DENTAL NO MED")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"DENTAL NO MED")):^("DENTAL NO MED")+1,1:1)
QUIT
+4 IF $TEXT(@APCLCLN)]""
SET ^("NONAPCCLN")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"NONAPCCLN")):^("NONAPCCLN")+1,1:1)
QUIT
+5 IF "AOS"[$PIECE(APCLVREC,U,7)
IF '$DATA(^AUPNVPOV("AD",APCLVIEN))
SET ^("AOS INCOMPLETE")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"AOS INCOMPLETE")):^("AOS INCOMPLETE")+1,1:1)
QUIT
+6 IF "AOS"[$PIECE(APCLVREC,U,7)
IF '$DATA(^AUPNVPRV("AD",APCLVIEN))
SET ^("AOS INCOMPLETE")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"AOS INCOMPLETE")):^("AOS INCOMPLETE")+1,1:1)
QUIT
+7 ;
PROC1 ;
+1 ;TABLE VISITS AND COUNT DUPLICATES BY PATIENT,DATE,CLINIC
+2 ;I $D(^XTMP("APCLAP9",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN)) S ^("DUPLICATE")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"DUPLICATE")):^("DUPLICATE")+1,1:1) Q
+3 ;E S ^XTMP("APCLAP9",APCLJOB,APCLBT,DFN,$P($P(APCLVREC,U),"."),APCLCLN)=""
+4 SET APCLAPC=APCLAPC+1
+5 IF $DATA(^AUPNVSIT("ADWO",$PIECE(APCLVREC,U,2),APCLVIEN))
SET ^("IN XREF")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1)
QUIT
+6 IF $DATA(^AUPNVSIT("ADWO",$PIECE($PIECE(APCLVREC,U,13),"."),APCLVIEN))
SET ^("IN XREF")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"IN XREF")):^("IN XREF")+1,1:1)
QUIT
+7 ;I $P(APCLVREC,U,14)="" S ^("NO EXPORT - ?")=$S($D(^XTMP("APCLAP9",APCLJOB,APCLBT,"NO EXPORT - ?")):^("NO EXPORT - ?")+1,1:1) Q
+8 IF $PIECE($GET(^AUPNVSIT(APCLVIEN,11)),U,6)=""
SET ^("NO EXPORT - ?")=$SELECT($DATA(^XTMP("APCLAP9",APCLJOB,APCLBT,"NO EXPORT - ?")):^("NO EXPORT - ?")+1,1:1)
QUIT
+9 QUIT
+10 ;
+11 ;
CLEX ;
09 ;;
11 ;;
36 ;;
41 ;;
42 ;;
51 ;;
52 ;;
53 ;;
54 ;;
60 ;;
99 ;;
