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