APCPSR1 ; IHS/TUCSON/LAB - ULATORY - OPERATIONS SUMMARY AUGUST 14, 1992 ; [ 08/18/03 6:03 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,3,6**;APR 03, 1998
;IHS/CMI/LAB - changed TMP to XTMP
V ;EP
S APCPSR("V")=0 F S APCPSR("V")=$O(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"))) Q:APCPSR("V")'=+APCPSR("V") D PROC
;D CHAERR
Q
PROC ;
Q:'$D(^AUPNVSIT(APCPSR("V"),0))
K APCPSR("SKIP CHA"),APCPSR("SKIP CLIN")
;I '$P(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,5) D SKIPPED,CHA,STATDB Q
D STATDB
Q
S APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"GEN"_""""
S ^("TOTAL")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN","TOTAL")):(+^("TOTAL")+1),1:1)
S APCPVAR=$S($P(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"PROV",1:"PROV HOSP") D PROV^APCPSR2
S APCPVAR=$S($P(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"LOC",1:"LOC HOSP") D LOC^APCPSR2
S APCPVAR=$S($P(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"V DATE",1:"V DATE HOSP") D VD^APCPSR2
S APCPVAR=$S($P(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"TYPE",1:"TYPE HOSP") D TYPE^APCPSR2
I $P(^AUPNVSIT(APCPSR("V"),0),U,7)'="H" S APCPVAR="CLINIC" D CLINIC^APCPSR2
S APCPVAR=$S($P(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"SC",1:"SC HOSP") D SC^APCPSR2
D CHA
D STATDB
Q
SKIPPED ;tally visits that were skipped/no tx generated
S APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"SKIPPED"_""""
S ^("TOTAL")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","TOTAL")):(+^("TOTAL")+1),1:1)
I $P(^AUPNVSIT(APCPSR("V"),0),U,11) S ^("DELV")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","DELV")):(+^("DELV")+1),1:1) Q
I $P(^AUPNVSIT(APCPSR("V"),0),U,5),$P(^DPT($P(^AUPNVSIT(APCPSR("V"),0),U,5),0),U)["DEMO,PATIENT" S ^("DEMO")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","DEMO")):(+^("DEMO")+1),1:1) Q
I $D(^APCPLOG(APCPSR("LOG"),51,"AC",APCPSR("V"))) D ERROR Q:APCPSR("ERR MSG")'="E054"
I "CV"[$P(^AUPNVSIT(APCPSR("V"),0),U,3) S APCPVAR="TYPE ERROR" D TYPE^APCPSR2 Q
I "XDETCIN"[$P(^AUPNVSIT(APCPSR("V"),0),U,7) S APCPVAR="SC ERROR" D SC^APCPSR2 Q
S APCPSR("CLN")=$P(^AUPNVSIT(APCPSR("V"),0),U,8)
D CLINSK
Q:$D(APCPSR("SKIP CLIN"))
;D CHAAPC
TALLY ;TALLY THE REMAINING VISITS
Q:$D(APCPSR("SKIP CHA"))
S ^("TOTALREM")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","TOTALREM")):(+^("TOTALREM")+1),1:1)
S APCPVAR="TYPE REM" D TYPE^APCPSR2 S APCPVAR="SC REM" D SC^APCPSR2 S APCPVAR="CLINIC REM" D CLINIC^APCPSR2 S APCPVAR="LOC REM" D LOC^APCPSR2 S APCPVAR="PROV REM" D PROV^APCPSR2 S APCPVAR="V DATE REM" D VD^APCPSR2
Q
DENTAL ;EP
Q:'$D(^AUPNVMED("AD",APCPSR("V")))
S ^("DENTWMEDS")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN","DENTWMEDS")):(+^("DENTWMEDS")+1),1:1)
Q
ERROR ;
S APCPSR("EDFN")=$O(^APCPLOG(APCPSR("LOG"),51,"AC",APCPSR("V"),""))
S APCPSR("ERR MSG")=$P(^APCPLOG(APCPSR("LOG"),51,APCPSR("EDFN"),0),U,3)
I $E(APCPSR("ERR MSG"),1,4)="E054" Q
S X="^XTMP("_APCPSR("PROC")_",""ERRORS"",APCPSR(""ERR MSG""))" D COUNT
S ^("TOTALERRS")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","TOTALERRS")):(+^("TOTALERRS")+1),1:1)
Q
CHA ;TALLY CHA TXS
Q
Q:'$P(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,6)
S APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"GEN"_""""
S APCPVAR="TYPE CHA" D TYPE^APCPSR2 S APCPVAR="SC CHA" D SC^APCPSR2 S APCPVAR="CLINIC CHA" D CLINIC^APCPSR2 S APCPVAR="LOC CHA" D LOC^APCPSR2 S APCPVAR="PROV CHA" D PROV^APCPSR2 S APCPVAR="V DATE CHA" D VD^APCPSR2
Q
CHAERR ;
S X=0 F S X=$O(^APCPLOG(APCPSR("LOG"),51,X)) Q:X'=+X I $E($P(^APCPLOG(APCPSR("LOG"),51,X,0),U,3),1,4)="E054" D
.S ^("CHAACTERR")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","CHAACTERR")):(+^("CHAACTERR")+1),1:1)
.Q
Q
CHAAPC ;
K APCPSR("SKIP CHA")
I $P(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,6) S ^("CHANOAPC")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","CHANOAPC")):(+^("CHANOAPC")+1),1:1),APCPSR("SKIP CHA")="" Q
S (APCPSR("1"),APCPSR("2"))=0 F S APCPSR("2")=$O(^AUPNVPRV("AD",APCPSR("V"),APCPSR("2"))) Q:APCPSR("2")="" I $P(^AUPNVPRV(APCPSR("2"),0),U,4)="P" S APCPSR("1")=APCPSR("1")+1,APCPSR("AP")=$P(^(0),U)
CHKDISC ;
S APCPSR("DISC")=$$VAL^XBDIQ1(APCPS("PROV FILE"),APCPSR("AP"),9999999.03)
S APCPSR("LOCC")=$E($P(^AUTTLOC($P(^AUPNVSIT(APCPSR("V"),0),U,6),0),U,10),5,6)
I (APCPSR("DISC")=13!(APCPSR("DISC")=32))&((APCPSR("LOCC")>49)!(APCPSR("LOCC")'=+APCPSR("LOCC"))) S ^("CHANOAPC")=$S($D(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","CHANOAPC")):(+^("CHANOAPC")+1),1:1),APCPSR("SKIP CHA")=""
;
Q
STATDB ;
D ^APCPSR3
Q
COUNT ;
I '$D(@X) S @X=0
S %=@X,%=%+1,@X=%
Q
CLINSK ;
K APCPSR("SKIP CLIN")
Q:APCPSR("CLN")=""
S APCPSR("CLN CODE")=$P(^DIC(40.7,APCPSR("CLN"),0),U,2),APCPSR("CLN")=$P(^DIC(40.7,APCPSR("CLN"),0),U)
S X="C"_APCPSR("CLN CODE") Q:$T(@X)=""
I X="C56",$D(^AUPNVMED("AD",APCPSR("V"))) Q
S APCPVAR="CLINIC ERROR"
D SETCLIN^APCPSR2 S APCPSR("SKIP CLIN")=""
Q
;
C42 ;
C51 ;
C52 ;
C53 ;
C54 ;
C56 ;
C60 ;
APCPSR1 ; IHS/TUCSON/LAB - ULATORY - OPERATIONS SUMMARY AUGUST 14, 1992 ; [ 08/18/03 6:03 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,3,6**;APR 03, 1998
+2 ;IHS/CMI/LAB - changed TMP to XTMP
V ;EP
+1 SET APCPSR("V")=0
FOR
SET APCPSR("V")=$ORDER(^APCPLOG(APCPSR("LOG"),21,APCPSR("V")))
IF APCPSR("V")'=+APCPSR("V")
QUIT
DO PROC
+2 ;D CHAERR
+3 QUIT
PROC ;
+1 IF '$DATA(^AUPNVSIT(APCPSR("V"),0))
QUIT
+2 KILL APCPSR("SKIP CHA"),APCPSR("SKIP CLIN")
+3 ;I '$P(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,5) D SKIPPED,CHA,STATDB Q
+4 DO STATDB
+5 QUIT
+6 SET APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"GEN"_""""
+7 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN","TOTAL")):(+^("TOTAL")+1),1:1)
+8 SET APCPVAR=$SELECT($PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"PROV",1:"PROV HOSP")
DO PROV^APCPSR2
+9 SET APCPVAR=$SELECT($PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"LOC",1:"LOC HOSP")
DO LOC^APCPSR2
+10 SET APCPVAR=$SELECT($PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"V DATE",1:"V DATE HOSP")
DO VD^APCPSR2
+11 SET APCPVAR=$SELECT($PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"TYPE",1:"TYPE HOSP")
DO TYPE^APCPSR2
+12 IF $PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)'="H"
SET APCPVAR="CLINIC"
DO CLINIC^APCPSR2
+13 SET APCPVAR=$SELECT($PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)'="H":"SC",1:"SC HOSP")
DO SC^APCPSR2
+14 DO CHA
+15 DO STATDB
+16 QUIT
SKIPPED ;tally visits that were skipped/no tx generated
+1 SET APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"SKIPPED"_""""
+2 SET ^("TOTAL")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","TOTAL")):(+^("TOTAL")+1),1:1)
+3 IF $PIECE(^AUPNVSIT(APCPSR("V"),0),U,11)
SET ^("DELV")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","DELV")):(+^("DELV")+1),1:1)
QUIT
+4 IF $PIECE(^AUPNVSIT(APCPSR("V"),0),U,5)
IF $PIECE(^DPT($PIECE(^AUPNVSIT(APCPSR("V"),0),U,5),0),U)["DEMO,PATIENT"
SET ^("DEMO")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","DEMO")):(+^("DEMO")+1),1:1)
QUIT
+5 IF $DATA(^APCPLOG(APCPSR("LOG"),51,"AC",APCPSR("V")))
DO ERROR
IF APCPSR("ERR MSG")'="E054"
QUIT
+6 IF "CV"[$PIECE(^AUPNVSIT(APCPSR("V"),0),U,3)
SET APCPVAR="TYPE ERROR"
DO TYPE^APCPSR2
QUIT
+7 IF "XDETCIN"[$PIECE(^AUPNVSIT(APCPSR("V"),0),U,7)
SET APCPVAR="SC ERROR"
DO SC^APCPSR2
QUIT
+8 SET APCPSR("CLN")=$PIECE(^AUPNVSIT(APCPSR("V"),0),U,8)
+9 DO CLINSK
+10 IF $DATA(APCPSR("SKIP CLIN"))
QUIT
+11 ;D CHAAPC
TALLY ;TALLY THE REMAINING VISITS
+1 IF $DATA(APCPSR("SKIP CHA"))
QUIT
+2 SET ^("TOTALREM")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","TOTALREM")):(+^("TOTALREM")+1),1:1)
+3 SET APCPVAR="TYPE REM"
DO TYPE^APCPSR2
SET APCPVAR="SC REM"
DO SC^APCPSR2
SET APCPVAR="CLINIC REM"
DO CLINIC^APCPSR2
SET APCPVAR="LOC REM"
DO LOC^APCPSR2
SET APCPVAR="PROV REM"
DO PROV^APCPSR2
SET APCPVAR="V DATE REM"
DO VD^APCPSR2
+4 QUIT
DENTAL ;EP
+1 IF '$DATA(^AUPNVMED("AD",APCPSR("V")))
QUIT
+2 SET ^("DENTWMEDS")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"GEN","DENTWMEDS")):(+^("DENTWMEDS")+1),1:1)
+3 QUIT
ERROR ;
+1 SET APCPSR("EDFN")=$ORDER(^APCPLOG(APCPSR("LOG"),51,"AC",APCPSR("V"),""))
+2 SET APCPSR("ERR MSG")=$PIECE(^APCPLOG(APCPSR("LOG"),51,APCPSR("EDFN"),0),U,3)
+3 IF $EXTRACT(APCPSR("ERR MSG"),1,4)="E054"
QUIT
+4 SET X="^XTMP("_APCPSR("PROC")_",""ERRORS"",APCPSR(""ERR MSG""))"
DO COUNT
+5 SET ^("TOTALERRS")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","TOTALERRS")):(+^("TOTALERRS")+1),1:1)
+6 QUIT
CHA ;TALLY CHA TXS
+1 QUIT
+2 IF '$PIECE(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,6)
QUIT
+3 SET APCPSR("PROC")=""""_APCPSR_""",APCPJOB,APCPBTH,"_""""_"GEN"_""""
+4 SET APCPVAR="TYPE CHA"
DO TYPE^APCPSR2
SET APCPVAR="SC CHA"
DO SC^APCPSR2
SET APCPVAR="CLINIC CHA"
DO CLINIC^APCPSR2
SET APCPVAR="LOC CHA"
DO LOC^APCPSR2
SET APCPVAR="PROV CHA"
DO PROV^APCPSR2
SET APCPVAR="V DATE CHA"
DO VD^APCPSR2
+5 QUIT
CHAERR ;
+1 SET X=0
FOR
SET X=$ORDER(^APCPLOG(APCPSR("LOG"),51,X))
IF X'=+X
QUIT
IF $EXTRACT($PIECE(^APCPLOG(APCPSR("LOG"),51,X,0),U,3),1,4)="E054"
Begin DoDot:1
+2 SET ^("CHAACTERR")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","CHAACTERR")):(+^("CHAACTERR")+1),1:1)
+3 QUIT
End DoDot:1
+4 QUIT
CHAAPC ;
+1 KILL APCPSR("SKIP CHA")
+2 IF $PIECE(^APCPLOG(APCPSR("LOG"),21,APCPSR("V"),0),U,6)
SET ^("CHANOAPC")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","CHANOAPC")):(+^("CHANOAPC")+1),1:1)
SET APCPSR("SKIP CHA")=""
QUIT
+3 SET (APCPSR("1"),APCPSR("2"))=0
FOR
SET APCPSR("2")=$ORDER(^AUPNVPRV("AD",APCPSR("V"),APCPSR("2")))
IF APCPSR("2")=""
QUIT
IF $PIECE(^AUPNVPRV(APCPSR("2"),0),U,4)="P"
SET APCPSR("1")=APCPSR("1")+1
SET APCPSR("AP")=$PIECE(^(0),U)
CHKDISC ;
+1 SET APCPSR("DISC")=$$VAL^XBDIQ1(APCPS("PROV FILE"),APCPSR("AP"),9999999.03)
+2 SET APCPSR("LOCC")=$EXTRACT($PIECE(^AUTTLOC($PIECE(^AUPNVSIT(APCPSR("V"),0),U,6),0),U,10),5,6)
+3 IF (APCPSR("DISC")=13!(APCPSR("DISC")=32))&((APCPSR("LOCC")>49)!(APCPSR("LOCC")'=+APCPSR("LOCC")))
SET ^("CHANOAPC")=$SELECT($DATA(^XTMP("APCPSR",APCPJOB,APCPBTH,"SKIPPED","CHANOAPC")):(+^("CHANOAPC")+1),1:1)
SET APCPSR("SKIP CHA")=""
+4 ;
+5 QUIT
STATDB ;
+1 DO ^APCPSR3
+2 QUIT
COUNT ;
+1 IF '$DATA(@X)
SET @X=0
+2 SET %=@X
SET %=%+1
SET @X=%
+3 QUIT
CLINSK ;
+1 KILL APCPSR("SKIP CLIN")
+2 IF APCPSR("CLN")=""
QUIT
+3 SET APCPSR("CLN CODE")=$PIECE(^DIC(40.7,APCPSR("CLN"),0),U,2)
SET APCPSR("CLN")=$PIECE(^DIC(40.7,APCPSR("CLN"),0),U)
+4 SET X="C"_APCPSR("CLN CODE")
IF $TEXT(@X)=""
QUIT
+5 IF X="C56"
IF $DATA(^AUPNVMED("AD",APCPSR("V")))
QUIT
+6 SET APCPVAR="CLINIC ERROR"
+7 DO SETCLIN^APCPSR2
SET APCPSR("SKIP CLIN")=""
+8 QUIT
+9 ;
C42 ;
C51 ;
C52 ;
C53 ;
C54 ;
C56 ;
C60 ;
