APCDFPPV ; IHS/CMI/LAB - PRINT UNCODED DX ;
;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
;
LOC ;
K APCDLOCT S APCDLOCT=""
S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) XIT
S APCDLOCT=Y
I APCDLOCT="A" G DATE
D @APCDLOCT
G:$D(APCDQUIT) LOC
DATE ;
S APCDFILE=9000010.07
W !!,"The search for Uncoded "_$P(^DIC(APCDFILE,0),U),"'s can begin at any date",!,"that you specify. To get all of the uncoded entries enter a really early "
W !,"date like 01/01/1930. If you want to only review data for visits ",!,"in the past week, enter T-7.",!
S APCDFUDT=""
S DIR(0)="D^::EP",DIR("A")="Enter the Beginning Date to Search for Uncoded entries" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G LOC
S APCDFUDT=Y
S DIR(0)="D^::EP",DIR("A")="Enter the Ending Date to Search for Uncoded entries" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G LOC
S APCDFUET=Y
I APCDFUET<APCDFUDT W !,"Ending date cannot be before beginning date." G DATE
PROV ;
K APCDPRVT S APCDPRVT=""
S DIR(0)="S^A:ALL Providers (PRIMARY);O:ONE Provider (PRIMARY)",DIR("A")="Include Visits to Which Provider",DIR("B")="A"
S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) XIT
S APCDPRVT=Y
I APCDPRVT="A" G FILE
K DIC S DIC("A")="Which Provider: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:X="^" PROV K DIC,DA
G:Y=-1 PROV
S APCDPRVT("ONE")=+Y
FILE ;WHICH FILE?
S APCDWFIL=""
S DIR(0)="S^POV:V POV;PRB:PROBLEM LIST;PRC:V PROCEDURE;FH:FAMILY HISTORY;PHX:PERSONAL HISTORY;A:ALL OF THE ABOVE"
S DIR("A")="Which File would like to print from",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PROV
S APCDWFIL=Y
ZIS ;
S APCDCODE=$P($$ICDDX^ICDEX(".9999"),U,1)
I APCDCODE="" W !!,"ERROR -- .9999 NOT IN ICD DIAGNOSIS FILE, NOTIFY YOUR SUPERVISOR" H 3 G XIT
S APCDCODO=$P($$ICDDX^ICDEX("ZZZ.999"),U,1)
I APCDCODO="" W !!,"ERROR -- ZZZ.999 NOT IN ICD DIAGNOSIS FILE, NOTIFY YOUR SUPERVISOR" H 3 G XIT
S APCDCODE=$P($$ICDOP^ICDEX(".9999",,,"E"),U,1)
S APCDCODO=$P($$ICDOP^ICDEX("ZZZ999",,,"E"),U,1)
I APCDCODE="" W !!,"ERROR -- .9999 NOT IN ICD OPERATION FILE, NOTIFY YOUR SUPERVISOR" H 3 G XIT
I APCDCODO="" W !!,"ERROR -- ZZZ999 NOT IN ICD OPERATON FILE, NOTIFY YOUR SUPERVISOR" H 3 G XIT
K IO("Q")
W !!,"Enter the Device for printing"
S %ZIS="PQ" D ^%ZIS
I POP K IO("Q") G XIT
I $D(IO("Q")) G TSKMN
;
EN ; Entry point if for taskman.
S %DT="",X="T" D ^%DT X ^DD("DD") S APCDDT=Y
U IO
S APCDFILE="",APCDPG=0
K ^TMP($J,"APCDFPPV")
;D HEAD
GETCODE ;
;
S APCDCODE=$P($$ICDDX^ICDEX(".9999"),U,1)
S APCDCODO=$P($$ICDDX^ICDEX("ZZZ.999"),U,1)
I APCDWFIL="A" F APCDFILE=9000010.07,9000011,9000014,9000013 D PROC
I APCDWFIL="POV" F APCDFILE=9000010.07 D PROC Q:$D(APCDQUIT)
I APCDWFIL="PRB" F APCDFILE=9000011 D PROC Q:$D(APCDQUIT)
I APCDWFIL="PHX" F APCDFILE=9000013 D PROC Q:$D(APCDQUIT)
I APCDWFIL="FH" F APCDFILE=9000014 D PROC Q:$D(APCDQUIT)
S APCDCODE=$P($$ICDOP^ICDEX(".9999",,,"E"),U,1)
S APCDCODO=$P($$ICDOP^ICDEX("ZZZ999",,,"E"),U,1)
I APCDWFIL="PRC"!(APCDWFIL="A") F APCDFILE=9000010.08 D PROC Q:$D(APCDQUIT)
D PRINT
S:$D(ZTQUEUED) ZTREQ="@"
;
XIT K APCDDOB,APCDDFN,APCDFILE,IO("Q"),APCDVDG,APCDCODE,APCDG,APCDVIGR,APCDHRN,APCDF,APCDDT,APCDL,APCDPG,APCDQUIT,ZTSK,APCDVCTR
K AUPNSEX,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,APCDVSIT,APCDLOCT,APCDOK,APCDFUET,APCDFPPV,APCDFUDT,APCDPRVT
K A,DX,Y,X,S,DA,D0,DIC,DIE,DIQ,DK,DL,DR,POP,D1,D2
K ^TMP($J,"APCDFPPV")
D ^%ZISC
Q
CHKLOC ;
S APCDVSIT=""
I $L(APCDFILE)=7,APCDFILE'=9000011 S APCDOK=1 Q
I APCDFILE=9000011 S Y=$P(^AUPNPROB(APCDDFN,0),U,6) D Q
.I APCDLOCT="O",Y'=APCDLOCT("ONE") S APCDOK=0 Q
.I APCDLOCT="S",$$VALI^XBDIQ1(9999999.06,$P(^AUPNPROB(APCDDFN,0),U,6),.05)'=APCDLOCT("SU") S APCDOK=0 Q
.S APCDOK=1
S APCDOK=0
S APCDG=APCDVDG_"APCDDFN,0)" S Y=$P(@APCDG,U,2),APCDVSIT=$P(@APCDG,U,3) I Y=""!(APCDVSIT="") W !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING" Q
I APCDLOCT="O",$P(^AUPNVSIT(APCDVSIT,0),U,6)'=APCDLOCT("ONE") Q
I APCDLOCT="S",$$VALI^XBDIQ1(9999999.06,$P(^AUPNVSIT(APCDVSIT,0),U,6),.05)'=APCDLOCT("SU") Q
S APCDOK=1
Q
CHKPRV ;
S APCDVSIT="" I $L(APCDFILE)=7 S APCDOK=1 Q
S APCDOK=0
S APCDG=APCDVDG_"APCDDFN,0)" S Y=$P(@APCDG,U,2),APCDVSIT=$P(@APCDG,U,3) I Y=""!(APCDVSIT="") W !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING" Q
I APCDPRVT="O",$$PRIMPROV^APCLV(APCDVSIT,"I")'=APCDPRVT("ONE") Q
S APCDOK=1
Q
O ;one community
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
I Y=-1 S APCDQUIT="" Q
S APCDLOCT("ONE")=+Y
Q
S ;all communities within APCDSU su
S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
I Y=-1 S APCDQUIT="" Q
S APCDLOCT("SU")=+Y
Q
;
PROC ;
K APCDQUIT
S APCDDFN=""
S APCDVDG=^DIC(APCDFILE,0,"GL")
S APCDG=APCDVDG_"""B"",APCDCODE)"
S APCDVIGR=APCDVDG_"""B"",APCDCODE,APCDDFN)"
S APCDDFN=0 F S APCDDFN=$O(@APCDVIGR) Q:APCDDFN'=+APCDDFN!($D(APCDQUIT)) S APCDOK=0 D CHKLOC I APCDOK D CHKPRV I APCDOK D PRT
S APCDG=APCDVDG_"""B"",APCDCODO)"
S APCDVIGR=APCDVDG_"""B"",APCDCODO,APCDDFN)"
S APCDDFN=0 F S APCDDFN=$O(@APCDVIGR) Q:APCDDFN'=+APCDDFN!($D(APCDQUIT)) S APCDOK=0 D CHKLOC I APCDOK D CHKPRV I APCDOK D PRT
Q
PRT ;
D CHKDATE I 'APCDOK Q
I APCDFILE=9000011,$P(^AUPNPROB(APCDDFN,0),U,12)="D" Q ;deleted
I APCDFILE=9000011,$P($G(^AUPNPROB(APCDDFN,800)),U,1)]"" Q ;SNOME CODED
S ^TMP($J,"APCDFPPV",APCDFILE,APCDDFN)=""
Q
PRINT ;
I '$D(^TMP($J,"APCDFPPV")) D HEAD W !!,"There are no Uncoded entries." D XIT Q
;D HEAD
S APCDFILE="" F S APCDFILE=$O(^TMP($J,"APCDFPPV",APCDFILE)) Q:APCDFILE=""!($D(APCDQUIT)) D
.D HEAD
.Q:$D(APCDQUIT)
.W !!,$P(^DIC(APCDFILE,0),U,1)," uncoded entries: "
.S APCDDFN=0 F S APCDDFN=$O(^TMP($J,"APCDFPPV",APCDFILE,APCDDFN)) Q:APCDDFN=""!($D(APCDQUIT)) D
..S Y=$$VALI^XBDIQ1(APCDFILE,APCDDFN,.02)
..S APCDVSIT="" I $L(APCDFILE)>7 S APCDVSIT=$$VALI^XBDIQ1(APCDFILE,APCDDFN,.03)
..D ^AUPNPAT
..S Y=AUPNDOB X ^DD("DD") S APCDDOB=Y
..S APCDHRN="" I $D(^AUPNPAT(AUPNPAT,41,DUZ(2),0)) S APCDHRN=$P(^AUPNPAT(AUPNPAT,41,DUZ(2),0),U,2)
..I $Y>(IOSL-7) D HEAD Q:$D(APCDQUIT)
..W !!,"HRN: ",APCDHRN," DOB: ",APCDDOB," SEX: ",AUPNSEX
..S DA=APCDDFN,DIC=^DIC(APCDFILE,0,"GL"),DR=0 D EN^DIQ K DIC,DA,DR
..I APCDVSIT,$L(APCDFILE)>7 S APCDVCTR=$$OPER(APCDVSIT) W ?2,"OPERATOR FROM FORMS TRACKING OR CREATED BY: " I APCDVCTR W $P(^VA(200,APCDVCTR,0),U) W !
..I APCDVSIT,$L(APCDFILE)>7 W ?2,"LOCATION OF ENCOUNTER: ",$$LOCENC^APCLV(APCDVSIT,"E")
..I APCDVSIT,$L(APCDFILE)>7 W !?2,"PROVIDER: ",$$PRIMPROV^APCLV(APCDVSIT,"N")
..I APCDFILE=9000011,$P($G(^AUPNPROB(APCDDFN,1)),U,4)]"" W ?2,"RECORDING PROVIDER: ",$$VAL^XBDIQ1(9000011,APCDDFN,1.04),!
..I APCDFILE=9000011,$P($G(^AUPNPROB(APCDDFN,1)),U,3)]"" W ?2,"ENTERED BY: ",$$VAL^XBDIQ1(9000011,APCDDFN,1.03),!
..I APCDFILE=9000011,$P($G(^AUPNPROB(APCDDFN,1)),U,5)]"" W !?2,"RESPONSIBLE PROVIDER: ",$$VAL^XBDIQ1(9000011,APCDDFN,1.05)
Q
;
OPER(V) ;
I $G(V)="" Q ""
;find operator in forms tracking first, if none return .23 of visit (user who created)
NEW Y,D,M S Y=""
S D=$O(^APCDFORM("AB",V,"")) I D="" Q $P(^AUPNVSIT(V,0),U,23)
S M=$O(^APCDFORM("AB",V,D,"")) I M="" Q $P(^AUPNVSIT(V,0),U,23)
S Y=$P(^APCDFORM(D,11,M,0),U,2)
Q $S(Y:Y,1:$P(^AUPNVSIT(V,0),U,23))
NONE ;
W !!,"There are no Uncoded diagnoses or procedures in the ",$P(^DIC(APCDFILE,0),U)," file."
Q
CHKDATE ;
S APCDOK=0
S APCDG=APCDVDG_"APCDDFN,0)" S Y=$P(@APCDG,U,2),APCDVSIT=$P(@APCDG,U,3) I Y=""!(APCDVSIT="") W !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING" Q
I $L(APCDFILE)>7 Q:'$D(^AUPNVSIT(APCDVSIT)) I $P($P(^AUPNVSIT(APCDVSIT,0),U),".")<APCDFUDT!($P($P(^AUPNVSIT(APCDVSIT,0),U),".")>APCDFUET) Q ;before date wanted
I $L(APCDFILE)=7,$P(@APCDG,U,3)<APCDFUDT Q ;quit if problem modified before date
S APCDOK=1
Q
HEAD ;
I 'APCDPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR I Y=0!($D(DTOUT)) K DIR S APCDQUIT="" Q
HEAD1 ;
;
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !,APCDDT,?70,"Page: ",APCDPG
W !?29,"PCC Data Entry Module"
W !?16,"***********************************************"
W !?16,"* LISTING OF UNCODED DIAGNOSES AND PROCEDURES *"
W !?16,"***********************************************"
Q
SUBHEAD ;
W !!,"Uncoded ",$P(^DIC(APCDFILE,0),U)," entries:"
Q
TSKMN ;
K ZTSAVE
S ZTSAVE("APCD*")=""
S ZTSAVE("DUZ(2)")="",ZTIO=ION,ZTCPU=$G(IOCPU),ZTRTN="EN^APCDFPPV",ZTDTH="",ZTDESC="VISIT ERROR REPORT - DATA ENTRY" D ^%ZTLOAD
D XIT
Q
DOC ;
; need to change to go thru PT node of ICD9 and
; fix all files in the 9000001-9000099 range.
;
APCDFPPV ; IHS/CMI/LAB - PRINT UNCODED DX ;
+1 ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
+2 ;
LOC ;
+1 KILL APCDLOCT
SET APCDLOCT=""
+2 SET DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility"
SET DIR("A")="Include Visits to Which Location/Facilities"
SET DIR("B")="A"
+3 SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO XIT
+5 SET APCDLOCT=Y
+6 IF APCDLOCT="A"
GOTO DATE
+7 DO @APCDLOCT
+8 IF $DATA(APCDQUIT)
GOTO LOC
DATE ;
+1 SET APCDFILE=9000010.07
+2 WRITE !!,"The search for Uncoded "_$PIECE(^DIC(APCDFILE,0),U),"'s can begin at any date",!,"that you specify. To get all of the uncoded entries enter a really early "
+3 WRITE !,"date like 01/01/1930. If you want to only review data for visits ",!,"in the past week, enter T-7.",!
+4 SET APCDFUDT=""
+5 SET DIR(0)="D^::EP"
SET DIR("A")="Enter the Beginning Date to Search for Uncoded entries"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO LOC
+7 SET APCDFUDT=Y
+8 SET DIR(0)="D^::EP"
SET DIR("A")="Enter the Ending Date to Search for Uncoded entries"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO LOC
+10 SET APCDFUET=Y
+11 IF APCDFUET<APCDFUDT
WRITE !,"Ending date cannot be before beginning date."
GOTO DATE
PROV ;
+1 KILL APCDPRVT
SET APCDPRVT=""
+2 SET DIR(0)="S^A:ALL Providers (PRIMARY);O:ONE Provider (PRIMARY)"
SET DIR("A")="Include Visits to Which Provider"
SET DIR("B")="A"
+3 SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO XIT
+5 SET APCDPRVT=Y
+6 IF APCDPRVT="A"
GOTO FILE
+7 KILL DIC
SET DIC("A")="Which Provider: "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF X="^"
GOTO PROV
KILL DIC,DA
+8 IF Y=-1
GOTO PROV
+9 SET APCDPRVT("ONE")=+Y
FILE ;WHICH FILE?
+1 SET APCDWFIL=""
+2 SET DIR(0)="S^POV:V POV;PRB:PROBLEM LIST;PRC:V PROCEDURE;FH:FAMILY HISTORY;PHX:PERSONAL HISTORY;A:ALL OF THE ABOVE"
+3 SET DIR("A")="Which File would like to print from"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO PROV
+5 SET APCDWFIL=Y
ZIS ;
+1 SET APCDCODE=$PIECE($$ICDDX^ICDEX(".9999"),U,1)
+2 IF APCDCODE=""
WRITE !!,"ERROR -- .9999 NOT IN ICD DIAGNOSIS FILE, NOTIFY YOUR SUPERVISOR"
HANG 3
GOTO XIT
+3 SET APCDCODO=$PIECE($$ICDDX^ICDEX("ZZZ.999"),U,1)
+4 IF APCDCODO=""
WRITE !!,"ERROR -- ZZZ.999 NOT IN ICD DIAGNOSIS FILE, NOTIFY YOUR SUPERVISOR"
HANG 3
GOTO XIT
+5 SET APCDCODE=$PIECE($$ICDOP^ICDEX(".9999",,,"E"),U,1)
+6 SET APCDCODO=$PIECE($$ICDOP^ICDEX("ZZZ999",,,"E"),U,1)
+7 IF APCDCODE=""
WRITE !!,"ERROR -- .9999 NOT IN ICD OPERATION FILE, NOTIFY YOUR SUPERVISOR"
HANG 3
GOTO XIT
+8 IF APCDCODO=""
WRITE !!,"ERROR -- ZZZ999 NOT IN ICD OPERATON FILE, NOTIFY YOUR SUPERVISOR"
HANG 3
GOTO XIT
+9 KILL IO("Q")
+10 WRITE !!,"Enter the Device for printing"
+11 SET %ZIS="PQ"
DO ^%ZIS
+12 IF POP
KILL IO("Q")
GOTO XIT
+13 IF $DATA(IO("Q"))
GOTO TSKMN
+14 ;
EN ; Entry point if for taskman.
+1 SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET APCDDT=Y
+2 USE IO
+3 SET APCDFILE=""
SET APCDPG=0
+4 KILL ^TMP($JOB,"APCDFPPV")
+5 ;D HEAD
GETCODE ;
+1 ;
+2 SET APCDCODE=$PIECE($$ICDDX^ICDEX(".9999"),U,1)
+3 SET APCDCODO=$PIECE($$ICDDX^ICDEX("ZZZ.999"),U,1)
+4 IF APCDWFIL="A"
FOR APCDFILE=9000010.07,9000011,9000014,9000013
DO PROC
+5 IF APCDWFIL="POV"
FOR APCDFILE=9000010.07
DO PROC
IF $DATA(APCDQUIT)
QUIT
+6 IF APCDWFIL="PRB"
FOR APCDFILE=9000011
DO PROC
IF $DATA(APCDQUIT)
QUIT
+7 IF APCDWFIL="PHX"
FOR APCDFILE=9000013
DO PROC
IF $DATA(APCDQUIT)
QUIT
+8 IF APCDWFIL="FH"
FOR APCDFILE=9000014
DO PROC
IF $DATA(APCDQUIT)
QUIT
+9 SET APCDCODE=$PIECE($$ICDOP^ICDEX(".9999",,,"E"),U,1)
+10 SET APCDCODO=$PIECE($$ICDOP^ICDEX("ZZZ999",,,"E"),U,1)
+11 IF APCDWFIL="PRC"!(APCDWFIL="A")
FOR APCDFILE=9000010.08
DO PROC
IF $DATA(APCDQUIT)
QUIT
+12 DO PRINT
+13 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+14 ;
XIT KILL APCDDOB,APCDDFN,APCDFILE,IO("Q"),APCDVDG,APCDCODE,APCDG,APCDVIGR,APCDHRN,APCDF,APCDDT,APCDL,APCDPG,APCDQUIT,ZTSK,APCDVCTR
+1 KILL AUPNSEX,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,APCDVSIT,APCDLOCT,APCDOK,APCDFUET,APCDFPPV,APCDFUDT,APCDPRVT
+2 KILL A,DX,Y,X,S,DA,D0,DIC,DIE,DIQ,DK,DL,DR,POP,D1,D2
+3 KILL ^TMP($JOB,"APCDFPPV")
+4 DO ^%ZISC
+5 QUIT
CHKLOC ;
+1 SET APCDVSIT=""
+2 IF $LENGTH(APCDFILE)=7
IF APCDFILE'=9000011
SET APCDOK=1
QUIT
+3 IF APCDFILE=9000011
SET Y=$PIECE(^AUPNPROB(APCDDFN,0),U,6)
Begin DoDot:1
+4 IF APCDLOCT="O"
IF Y'=APCDLOCT("ONE")
SET APCDOK=0
QUIT
+5 IF APCDLOCT="S"
IF $$VALI^XBDIQ1(9999999.06,$PIECE(^AUPNPROB(APCDDFN,0),U,6),.05)'=APCDLOCT("SU")
SET APCDOK=0
QUIT
+6 SET APCDOK=1
End DoDot:1
QUIT
+7 SET APCDOK=0
+8 SET APCDG=APCDVDG_"APCDDFN,0)"
SET Y=$PIECE(@APCDG,U,2)
SET APCDVSIT=$PIECE(@APCDG,U,3)
IF Y=""!(APCDVSIT="")
WRITE !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING"
QUIT
+9 IF APCDLOCT="O"
IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,6)'=APCDLOCT("ONE")
QUIT
+10 IF APCDLOCT="S"
IF $$VALI^XBDIQ1(9999999.06,$PIECE(^AUPNVSIT(APCDVSIT,0),U,6),.05)'=APCDLOCT("SU")
QUIT
+11 SET APCDOK=1
+12 QUIT
CHKPRV ;
+1 SET APCDVSIT=""
IF $LENGTH(APCDFILE)=7
SET APCDOK=1
QUIT
+2 SET APCDOK=0
+3 SET APCDG=APCDVDG_"APCDDFN,0)"
SET Y=$PIECE(@APCDG,U,2)
SET APCDVSIT=$PIECE(@APCDG,U,3)
IF Y=""!(APCDVSIT="")
WRITE !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING"
QUIT
+4 IF APCDPRVT="O"
IF $$PRIMPROV^APCLV(APCDVSIT,"I")'=APCDPRVT("ONE")
QUIT
+5 SET APCDOK=1
+6 QUIT
O ;one community
+1 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which LOCATION: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCDQUIT=""
QUIT
+3 SET APCDLOCT("ONE")=+Y
+4 QUIT
S ;all communities within APCDSU su
+1 SET DIC="^AUTTSU("
SET DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05)
SET DIC(0)="AEMQ"
SET DIC("A")="Which SERVICE UNIT: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCDQUIT=""
QUIT
+3 SET APCDLOCT("SU")=+Y
+4 QUIT
+5 ;
PROC ;
+1 KILL APCDQUIT
+2 SET APCDDFN=""
+3 SET APCDVDG=^DIC(APCDFILE,0,"GL")
+4 SET APCDG=APCDVDG_"""B"",APCDCODE)"
+5 SET APCDVIGR=APCDVDG_"""B"",APCDCODE,APCDDFN)"
+6 SET APCDDFN=0
FOR
SET APCDDFN=$ORDER(@APCDVIGR)
IF APCDDFN'=+APCDDFN!($DATA(APCDQUIT))
QUIT
SET APCDOK=0
DO CHKLOC
IF APCDOK
DO CHKPRV
IF APCDOK
DO PRT
+7 SET APCDG=APCDVDG_"""B"",APCDCODO)"
+8 SET APCDVIGR=APCDVDG_"""B"",APCDCODO,APCDDFN)"
+9 SET APCDDFN=0
FOR
SET APCDDFN=$ORDER(@APCDVIGR)
IF APCDDFN'=+APCDDFN!($DATA(APCDQUIT))
QUIT
SET APCDOK=0
DO CHKLOC
IF APCDOK
DO CHKPRV
IF APCDOK
DO PRT
+10 QUIT
PRT ;
+1 DO CHKDATE
IF 'APCDOK
QUIT
+2 ;deleted
IF APCDFILE=9000011
IF $PIECE(^AUPNPROB(APCDDFN,0),U,12)="D"
QUIT
+3 ;SNOME CODED
IF APCDFILE=9000011
IF $PIECE($GET(^AUPNPROB(APCDDFN,800)),U,1)]""
QUIT
+4 SET ^TMP($JOB,"APCDFPPV",APCDFILE,APCDDFN)=""
+5 QUIT
PRINT ;
+1 IF '$DATA(^TMP($JOB,"APCDFPPV"))
DO HEAD
WRITE !!,"There are no Uncoded entries."
DO XIT
QUIT
+2 ;D HEAD
+3 SET APCDFILE=""
FOR
SET APCDFILE=$ORDER(^TMP($JOB,"APCDFPPV",APCDFILE))
IF APCDFILE=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+4 DO HEAD
+5 IF $DATA(APCDQUIT)
QUIT
+6 WRITE !!,$PIECE(^DIC(APCDFILE,0),U,1)," uncoded entries: "
+7 SET APCDDFN=0
FOR
SET APCDDFN=$ORDER(^TMP($JOB,"APCDFPPV",APCDFILE,APCDDFN))
IF APCDDFN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+8 SET Y=$$VALI^XBDIQ1(APCDFILE,APCDDFN,.02)
+9 SET APCDVSIT=""
IF $LENGTH(APCDFILE)>7
SET APCDVSIT=$$VALI^XBDIQ1(APCDFILE,APCDDFN,.03)
+10 DO ^AUPNPAT
+11 SET Y=AUPNDOB
XECUTE ^DD("DD")
SET APCDDOB=Y
+12 SET APCDHRN=""
IF $DATA(^AUPNPAT(AUPNPAT,41,DUZ(2),0))
SET APCDHRN=$PIECE(^AUPNPAT(AUPNPAT,41,DUZ(2),0),U,2)
+13 IF $Y>(IOSL-7)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+14 WRITE !!,"HRN: ",APCDHRN," DOB: ",APCDDOB," SEX: ",AUPNSEX
+15 SET DA=APCDDFN
SET DIC=^DIC(APCDFILE,0,"GL")
SET DR=0
DO EN^DIQ
KILL DIC,DA,DR
+16 IF APCDVSIT
IF $LENGTH(APCDFILE)>7
SET APCDVCTR=$$OPER(APCDVSIT)
WRITE ?2,"OPERATOR FROM FORMS TRACKING OR CREATED BY: "
IF APCDVCTR
WRITE $PIECE(^VA(200,APCDVCTR,0),U)
WRITE !
+17 IF APCDVSIT
IF $LENGTH(APCDFILE)>7
WRITE ?2,"LOCATION OF ENCOUNTER: ",$$LOCENC^APCLV(APCDVSIT,"E")
+18 IF APCDVSIT
IF $LENGTH(APCDFILE)>7
WRITE !?2,"PROVIDER: ",$$PRIMPROV^APCLV(APCDVSIT,"N")
+19 IF APCDFILE=9000011
IF $PIECE($GET(^AUPNPROB(APCDDFN,1)),U,4)]""
WRITE ?2,"RECORDING PROVIDER: ",$$VAL^XBDIQ1(9000011,APCDDFN,1.04),!
+20 IF APCDFILE=9000011
IF $PIECE($GET(^AUPNPROB(APCDDFN,1)),U,3)]""
WRITE ?2,"ENTERED BY: ",$$VAL^XBDIQ1(9000011,APCDDFN,1.03),!
+21 IF APCDFILE=9000011
IF $PIECE($GET(^AUPNPROB(APCDDFN,1)),U,5)]""
WRITE !?2,"RESPONSIBLE PROVIDER: ",$$VAL^XBDIQ1(9000011,APCDDFN,1.05)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
OPER(V) ;
+1 IF $GET(V)=""
QUIT ""
+2 ;find operator in forms tracking first, if none return .23 of visit (user who created)
+3 NEW Y,D,M
SET Y=""
+4 SET D=$ORDER(^APCDFORM("AB",V,""))
IF D=""
QUIT $PIECE(^AUPNVSIT(V,0),U,23)
+5 SET M=$ORDER(^APCDFORM("AB",V,D,""))
IF M=""
QUIT $PIECE(^AUPNVSIT(V,0),U,23)
+6 SET Y=$PIECE(^APCDFORM(D,11,M,0),U,2)
+7 QUIT $SELECT(Y:Y,1:$PIECE(^AUPNVSIT(V,0),U,23))
NONE ;
+1 WRITE !!,"There are no Uncoded diagnoses or procedures in the ",$PIECE(^DIC(APCDFILE,0),U)," file."
+2 QUIT
CHKDATE ;
+1 SET APCDOK=0
+2 SET APCDG=APCDVDG_"APCDDFN,0)"
SET Y=$PIECE(@APCDG,U,2)
SET APCDVSIT=$PIECE(@APCDG,U,3)
IF Y=""!(APCDVSIT="")
WRITE !,"ERROR IN GLOBAL -- NOTIFY PROGRAMMER - PATIENT OR VISIT DFN MISSING"
QUIT
+3 ;before date wanted
IF $LENGTH(APCDFILE)>7
IF '$DATA(^AUPNVSIT(APCDVSIT))
QUIT
IF $PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")<APCDFUDT!($PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")>APCDFUET)
QUIT
+4 ;quit if problem modified before date
IF $LENGTH(APCDFILE)=7
IF $PIECE(@APCDG,U,3)<APCDFUDT
QUIT
+5 SET APCDOK=1
+6 QUIT
HEAD ;
+1 IF 'APCDPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
IF Y=0!($DATA(DTOUT))
KILL DIR
SET APCDQUIT=""
QUIT
HEAD1 ;
+1 ;
+2 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+3 WRITE !,APCDDT,?70,"Page: ",APCDPG
+4 WRITE !?29,"PCC Data Entry Module"
+5 WRITE !?16,"***********************************************"
+6 WRITE !?16,"* LISTING OF UNCODED DIAGNOSES AND PROCEDURES *"
+7 WRITE !?16,"***********************************************"
+8 QUIT
SUBHEAD ;
+1 WRITE !!,"Uncoded ",$PIECE(^DIC(APCDFILE,0),U)," entries:"
+2 QUIT
TSKMN ;
+1 KILL ZTSAVE
+2 SET ZTSAVE("APCD*")=""
+3 SET ZTSAVE("DUZ(2)")=""
SET ZTIO=ION
SET ZTCPU=$GET(IOCPU)
SET ZTRTN="EN^APCDFPPV"
SET ZTDTH=""
SET ZTDESC="VISIT ERROR REPORT - DATA ENTRY"
DO ^%ZTLOAD
+4 DO XIT
+5 QUIT
DOC ;
+1 ; need to change to go thru PT node of ICD9 and
+2 ; fix all files in the 9000001-9000099 range.
+3 ;
