- 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 ;;
