APCDEIN ; IHS/CMI/LAB - INITIALIZE VARS ;
;;2.0;IHS PCC SUITE;**2,11,15,16**;MAY 14, 2009;Build 9
;
;
EN ;PEP - set up PCC Data Entry environment vars
I DUZ("AG")="I",'$D(APCDDUZ) K APCDDUZ S:$D(DUZ(0))#2 APCDDUZ=DUZ(0) S DUZ(0)="@"
I $G(DUZ("AG"))="" W !,$C(7),$C(7),"DUZ(""AG"") not defined..Use Kernel or Fix Kernel Site Parameters File!!" S APCDFLG=1 Q
S AUPNLK("INAC")="" ;per Diana 11-17-92 include inactive pats in lookupsL
I $P($G(^APCDSITE(DUZ(2),0)),U,34) K AUPNLK("INAC")
SITE ;
S APCDEIN=""
I $E(DUZ("AG"))="I" S:$D(DUZ(2))#2 APCDDUZ2=DUZ(2)
K ^TMP("APCD",$J)
K AUPNTALK
PARAM ;
I '$D(APCDPARM) D ^APCDVAR
S APCDBEEP=$C(7)_$C(7),APCDFLG=0,APCDMODE="A",APCDOVRR=1,AICDHLIM=20,XTLKHLIM=20
S X="",APCDFILE="9000010",APCDFLD=".01" S:$D(^DD(APCDFILE,APCDFLD,0)) X=^(0)
I X=""!(X]""&($P(X,U,2)'["D")) D DICERR G XIT
S X=$P(X,U,5,99) S:X[" X D:" X=$E(X,1,$F(X," X D:")-3) S ^TMP("APCD",$J,"APCDDATE")=X
;
XIT ; KILL VARIABLES AND QUIT
;
K %DT,X,Y,DIC,DIRUT,DIR
K APCDFILE,APCDFLD,APCDI,APCDN,APCDSTR,APCDY
Q
DICERR ; DICTIONARY OUT OF SYNC WITH PROGRAM
W !!,"Dictionary error for file,field ",APCDFILE,",",APCDFLD,". Notify programmer."
S APCDFLG=1
Q
;
HELPSC ;EP
D EN^DDIOL("Enter any of the following that you want excluded")
D EN^DDIOL("from the coding queue:")
D EN^DDIOL(" ")
Q
EHRESP ;EP
I $D(IOF) W @IOF
W !!,"EHR Coding Queue Parameter Update",!
K DIC
S DIC="^APCDSITE(",DIC(0)="AEMQ",DIC("B")=$P(^DIC(4,DUZ(2),0),U)
D ^DIC K DIC
I Y=-1 D ^XBFMK Q
S APCDSITE=+Y
D EDIT
W !!,"You have the option of seeing all visits in the coding queue"
W !,"regardless of how they were created. You can see all visits or"
W !,"limit the list of visits in the coding queue to only those"
W !,"on which a provider has been entered. If you choose to only"
W !,"see visits on which a provider was entered then you will not"
W !,"see visits that were created by an ancillary package. Most,"
W !,"if not all visits created by EHR users will have provider."
W !! S DIE="^APCDSITE(",DA=APCDSITE,DR=".28Include all visits in the coding queue list?" D ^DIE K DIE
W !! S DIE="^APCDSITE(",DA=APCDSITE,DR=".29Default Response for 'Is Coding Complete?' in Data Entry" D ^DIE K DIE
W !! S DIE="^APCDSITE(",DA=APCDSITE,DR=".32Require Chart Deficiency Reason on Visits marked as Incomplete?" D ^DIE K DIE
W !! S DIE="^APCDSITE(",DA=APCDSITE,DR=".38Number of days to chart w/ deficiencies is delinquent" D ^DIE K DIE
D ^XBFMK K APCDSITE
Q
DISPSC ;
W !!,"Service Category exclusions: If you would like to exclude"
W !,"visits with a particular service category from the list of"
W !,"visits displayed in the coding queue you must enter those"
W !,"service categories to the list below. For example, if you"
W !,"do not wish to have I - In Hospital visits in the list then"
W !,"you should add 'I' to the list."
W !,"Please note: If you leave the list blank (empty) then all"
W !,"direct (non-CHS) visits will display in the coding queue."
W !,"Historical EVENT visits never display in the coding queue.",!!
W !,"Your site is currently set up to exclude visits with the"
W !,"following service categories from the coding queue:"
I '$O(^APCDSITE(APCDSITE,13,0)) W !!,"None selected, All visit service categories will be included",!,"in the coding queue." Q
S X=0 F S X=$O(^APCDSITE(APCDSITE,13,X)) Q:X'=+X W !?10,$P(^APCDSITE(APCDSITE,13,X,0),U)," - ",$$EXTSET^XBFUNC(9000010,.07,$P(^APCDSITE(APCDSITE,13,X,0),U))
Q
EDIT ;
D DISPSC
S DIR(0)="S^A:Add another service category to the list;R:Remove a service category from the list;Q:Quit - list looks good"
S DIR("A")="Do you wish to",DIR("B")="Q" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I Y="Q" Q
I Y="A" D ADD
I Y="R" D REMOVE
G EDIT
ADD ;add to list of service categories
K DIR
S DIR(0)="S^A:AMBULATORY;H:HOSPITALIZATION;I:IN HOSPITAL;C:CHART REVIEW;T:TELECOMMUNICATIONS;D:DAY SURGERY;O:OBSERVATION;R:NURSING HOME;N:NOT FOUND;M:TELEMEDICINE"
S DIR("A")="Add which one" K DA D ^DIR KILL DIR
I $D(DIRUT) Q
I Y="" Q
S APCDA=Y
I $D(^APCDSITE(APCDSITE,13,"B",APCDA)) W !,"That one is already on the list.",! Q
D ^XBFMK
S X=APCDA,DA(1)=APCDSITE,DIC("P")=$P(^DD(9001001.2,1301,0),U,2),DIC(0)="L",DIC="^APCDSITE("_APCDSITE_",13,"
K DD,D0 D FILE^DICN
I Y=-1 W !!,"adding service category failed." H 2 Q
Q
REMOVE ;
I '$O(^APCDSITE(APCDSITE,13,0)) W !!,"There are none to remove!" Q
K DIR
K APCDX S APCDY=""
S X=0 F S X=$O(^APCDSITE(APCDSITE,13,X)) Q:X'=+X D
.;W !?10,$P(^APCDSITE(APCDSITE,13,X,0),U)," - ",$$EXTSET^XBFUNC(9000010,.07,$P(^APCDSITE(APCDSITE,13,X,0),U))
.S APCDV=$P(^APCDSITE(APCDSITE,13,X,0),U)
.S APCDY=APCDY_$S($D(APCDX):";",1:"")_APCDV_":"_$$EXTSET^XBFUNC(9000010,.07,APCDV)
.S APCDX(APCDV)=X
S DIR("A")="Remove which one",DIR(0)="S^"_APCDY K DA D ^DIR KILL DIR
I $D(DIRUT) Q
I Y="" Q
S APCDA=Y
D ^XBFMK
S DIE="^APCDSITE("_APCDSITE_",13,",DA(1)=APCDSITE,DA=APCDX(APCDA),DR=".01///@" D ^DIE
Q
CAH(L) ;EP
I '$G(L) Q 0
Q $P($G(^APCDSITE(L,0)),U,33)
APCDEIN ; IHS/CMI/LAB - INITIALIZE VARS ;
+1 ;;2.0;IHS PCC SUITE;**2,11,15,16**;MAY 14, 2009;Build 9
+2 ;
+3 ;
EN ;PEP - set up PCC Data Entry environment vars
+1 IF DUZ("AG")="I"
IF '$DATA(APCDDUZ)
KILL APCDDUZ
IF $DATA(DUZ(0))#2
SET APCDDUZ=DUZ(0)
SET DUZ(0)="@"
+2 IF $GET(DUZ("AG"))=""
WRITE !,$CHAR(7),$CHAR(7),"DUZ(""AG"") not defined..Use Kernel or Fix Kernel Site Parameters File!!"
SET APCDFLG=1
QUIT
+3 ;per Diana 11-17-92 include inactive pats in lookupsL
SET AUPNLK("INAC")=""
+4 IF $PIECE($GET(^APCDSITE(DUZ(2),0)),U,34)
KILL AUPNLK("INAC")
SITE ;
+1 SET APCDEIN=""
+2 IF $EXTRACT(DUZ("AG"))="I"
IF $DATA(DUZ(2))#2
SET APCDDUZ2=DUZ(2)
+3 KILL ^TMP("APCD",$JOB)
+4 KILL AUPNTALK
PARAM ;
+1 IF '$DATA(APCDPARM)
DO ^APCDVAR
+2 SET APCDBEEP=$CHAR(7)_$CHAR(7)
SET APCDFLG=0
SET APCDMODE="A"
SET APCDOVRR=1
SET AICDHLIM=20
SET XTLKHLIM=20
+3 SET X=""
SET APCDFILE="9000010"
SET APCDFLD=".01"
IF $DATA(^DD(APCDFILE,APCDFLD,0))
SET X=^(0)
+4 IF X=""!(X]""&($PIECE(X,U,2)'["D"))
DO DICERR
GOTO XIT
+5 SET X=$PIECE(X,U,5,99)
IF X[" X D
SET X=$EXTRACT(X,1,$FIND(X," X D:")-3)
SET ^TMP("APCD",$JOB,"APCDDATE")=X
+6 ;
XIT ; KILL VARIABLES AND QUIT
+1 ;
+2 KILL %DT,X,Y,DIC,DIRUT,DIR
+3 KILL APCDFILE,APCDFLD,APCDI,APCDN,APCDSTR,APCDY
+4 QUIT
DICERR ; DICTIONARY OUT OF SYNC WITH PROGRAM
+1 WRITE !!,"Dictionary error for file,field ",APCDFILE,",",APCDFLD,". Notify programmer."
+2 SET APCDFLG=1
+3 QUIT
+4 ;
HELPSC ;EP
+1 DO EN^DDIOL("Enter any of the following that you want excluded")
+2 DO EN^DDIOL("from the coding queue:")
+3 DO EN^DDIOL(" ")
+4 QUIT
EHRESP ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,"EHR Coding Queue Parameter Update",!
+3 KILL DIC
+4 SET DIC="^APCDSITE("
SET DIC(0)="AEMQ"
SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),U)
+5 DO ^DIC
KILL DIC
+6 IF Y=-1
DO ^XBFMK
QUIT
+7 SET APCDSITE=+Y
+8 DO EDIT
+9 WRITE !!,"You have the option of seeing all visits in the coding queue"
+10 WRITE !,"regardless of how they were created. You can see all visits or"
+11 WRITE !,"limit the list of visits in the coding queue to only those"
+12 WRITE !,"on which a provider has been entered. If you choose to only"
+13 WRITE !,"see visits on which a provider was entered then you will not"
+14 WRITE !,"see visits that were created by an ancillary package. Most,"
+15 WRITE !,"if not all visits created by EHR users will have provider."
+16 WRITE !!
SET DIE="^APCDSITE("
SET DA=APCDSITE
SET DR=".28Include all visits in the coding queue list?"
DO ^DIE
KILL DIE
+17 WRITE !!
SET DIE="^APCDSITE("
SET DA=APCDSITE
SET DR=".29Default Response for 'Is Coding Complete?' in Data Entry"
DO ^DIE
KILL DIE
+18 WRITE !!
SET DIE="^APCDSITE("
SET DA=APCDSITE
SET DR=".32Require Chart Deficiency Reason on Visits marked as Incomplete?"
DO ^DIE
KILL DIE
+19 WRITE !!
SET DIE="^APCDSITE("
SET DA=APCDSITE
SET DR=".38Number of days to chart w/ deficiencies is delinquent"
DO ^DIE
KILL DIE
+20 DO ^XBFMK
KILL APCDSITE
+21 QUIT
DISPSC ;
+1 WRITE !!,"Service Category exclusions: If you would like to exclude"
+2 WRITE !,"visits with a particular service category from the list of"
+3 WRITE !,"visits displayed in the coding queue you must enter those"
+4 WRITE !,"service categories to the list below. For example, if you"
+5 WRITE !,"do not wish to have I - In Hospital visits in the list then"
+6 WRITE !,"you should add 'I' to the list."
+7 WRITE !,"Please note: If you leave the list blank (empty) then all"
+8 WRITE !,"direct (non-CHS) visits will display in the coding queue."
+9 WRITE !,"Historical EVENT visits never display in the coding queue.",!!
+10 WRITE !,"Your site is currently set up to exclude visits with the"
+11 WRITE !,"following service categories from the coding queue:"
+12 IF '$ORDER(^APCDSITE(APCDSITE,13,0))
WRITE !!,"None selected, All visit service categories will be included",!,"in the coding queue."
QUIT
+13 SET X=0
FOR
SET X=$ORDER(^APCDSITE(APCDSITE,13,X))
IF X'=+X
QUIT
WRITE !?10,$PIECE(^APCDSITE(APCDSITE,13,X,0),U)," - ",$$EXTSET^XBFUNC(9000010,.07,$PIECE(^APCDSITE(APCDSITE,13,X,0),U))
+14 QUIT
EDIT ;
+1 DO DISPSC
+2 SET DIR(0)="S^A:Add another service category to the list;R:Remove a service category from the list;Q:Quit - list looks good"
+3 SET DIR("A")="Do you wish to"
SET DIR("B")="Q"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y="Q"
QUIT
+6 IF Y="A"
DO ADD
+7 IF Y="R"
DO REMOVE
+8 GOTO EDIT
ADD ;add to list of service categories
+1 KILL DIR
+2 SET DIR(0)="S^A:AMBULATORY;H:HOSPITALIZATION;I:IN HOSPITAL;C:CHART REVIEW;T:TELECOMMUNICATIONS;D:DAY SURGERY;O:OBSERVATION;R:NURSING HOME;N:NOT FOUND;M:TELEMEDICINE"
+3 SET DIR("A")="Add which one"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y=""
QUIT
+6 SET APCDA=Y
+7 IF $DATA(^APCDSITE(APCDSITE,13,"B",APCDA))
WRITE !,"That one is already on the list.",!
QUIT
+8 DO ^XBFMK
+9 SET X=APCDA
SET DA(1)=APCDSITE
SET DIC("P")=$PIECE(^DD(9001001.2,1301,0),U,2)
SET DIC(0)="L"
SET DIC="^APCDSITE("_APCDSITE_",13,"
+10 KILL DD,D0
DO FILE^DICN
+11 IF Y=-1
WRITE !!,"adding service category failed."
HANG 2
QUIT
+12 QUIT
REMOVE ;
+1 IF '$ORDER(^APCDSITE(APCDSITE,13,0))
WRITE !!,"There are none to remove!"
QUIT
+2 KILL DIR
+3 KILL APCDX
SET APCDY=""
+4 SET X=0
FOR
SET X=$ORDER(^APCDSITE(APCDSITE,13,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 ;W !?10,$P(^APCDSITE(APCDSITE,13,X,0),U)," - ",$$EXTSET^XBFUNC(9000010,.07,$P(^APCDSITE(APCDSITE,13,X,0),U))
+6 SET APCDV=$PIECE(^APCDSITE(APCDSITE,13,X,0),U)
+7 SET APCDY=APCDY_$SELECT($DATA(APCDX):";",1:"")_APCDV_":"_$$EXTSET^XBFUNC(9000010,.07,APCDV)
+8 SET APCDX(APCDV)=X
End DoDot:1
+9 SET DIR("A")="Remove which one"
SET DIR(0)="S^"_APCDY
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
QUIT
+11 IF Y=""
QUIT
+12 SET APCDA=Y
+13 DO ^XBFMK
+14 SET DIE="^APCDSITE("_APCDSITE_",13,"
SET DA(1)=APCDSITE
SET DA=APCDX(APCDA)
SET DR=".01///@"
DO ^DIE
+15 QUIT
CAH(L) ;EP
+1 IF '$GET(L)
QUIT 0
+2 QUIT $PIECE($GET(^APCDSITE(L,0)),U,33)