Routine: APCDEIN

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

DICERR ; DICTIONARY OUT OF SYNC WITH PROGRAM

 W !!,"Dictionary error for file,field ",APCDFILE,",",APCDFLD,". Notify programmer."

 S APCDFLG=1

HELPSC ;EP

 D EN^DDIOL("Enter any of the following that you want excluded")

 D EN^DDIOL("from the coding queue:")

 D EN^DDIOL(" ")

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

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

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

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

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)

APCDEIN.m