APCDEGP0.m

APCDEGP0 ; IHS/CMI/LAB - CONT. APCDEGP ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

POV1 ;EP;

 D ^XBFMK

 W !

 K APCDLOOK,APCDTNQP,APCDTERR,APCDTSKI,X

 D ^APCDAPOV

 I $D(APCDTSKI) S APCDPOV="" Q

 I $D(APCDTERR) G POV1

 S APCDPOV=APCDLOOK

 K APCDLOOK

 K DA,DIR,DIRUT,DUOUT,DTOUT,X,Y S DIR("A")="PROVIDER NARRATIVE",DIR(0)="9000010.07,.04" D ^DIR K DIR

 G:$D(DIRUT) POV1

 S APCDEGC=APCDEGC+1

 S ^TMP("APCDEGP",$J,"POV",APCDEGC,"APCDTPOV")=APCDPOV_U_"`"_+Y_U_2

 Q

PROV1 ;EP

 D ^XBFMK

 X:$D(^DD(9000010.06,.01,12.1)) ^DD(9000010.06,.01,12.1)

 S DIC=$S($P(^DD(9000010.06,.01,0),U,2)[200:"^VA(200,",1:"^DIC(6,"),DIC(0)="AEMQ",DIC("A")=$S('APCDEGPS:"Enter PRIMARY Provider.: ",1:"Enter SECONDARY Provider: ") D ^DIC K DIC ;IHS/CMI/LAB - added file 200 check

 I Y=-1 S APCDEGPR="" Q

 S APCDEGPR=+Y

 I APCDEGPS S APCDEGPC="S" G PROV11

 S APCDEGPS=1,APCDEGPC="P"

PROV11 S APCDEGC=APCDEGC+1

 S ^TMP("APCDEGP",$J,"PROV",APCDEGC,"APCDTPRV")="`"_APCDEGPR_U_APCDEGPC

 Q

CHECK ;EP;SEE IF PV AND PRO ENTERED CORRECTLY

 Q:$D(APCDMOD)

 S APCDMPQ=1

 I $P(^AUPNVSIT(APCDVSIT,0),U,7)="E" Q

 K APCDNOCL D ^APCDVCHK

 I APCDMODE'="M",'$D(^AUPNVPOV("AD",APCDVSIT)) W !,"PV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q

 I APCDMODE'="M",'$D(^AUPNVPRV("AD",APCDVSIT)) W !,"PRV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q

 I APCDMODE'="M",$D(APCDNOCL) W !,"CL mnemonic required!",!,$C(7) S:'$D(DTOUT) APCDMPQ=0 K APCDNOCL Q

 I APCDMODE'="M",$P(^AUPNVSIT(APCDVSIT,0),U,3)="C",'$D(^AUPNVCHS("AD",APCDVSIT)) W !,"CHA, CHH or CHI mnemonic required with Contract Visits!",$C(7) S:'$D(DTOUT) APCDMPQ=0 Q

 D DEDT^APCDEA2(APCDVSIT) I $P(APCDPARM,U,5)="Y",'$D(^APCDFORM("AB",APCDVSIT)) S APCDFV=APCDVSIT D ^APCDFORM K APCDFV

 Q

EDUC1 ;EP;

 D ^XBFMK

 X:$D(^DD(9000010.16,.01,12.1)) ^DD(9000010.16,.01,12.1)

 W !

 S DIC="^AUTTEDT(",DIC(0)="AEMQ",DIC("A")="Enter Educaton TOPIC: " D ^DIC K DIC

 I Y=-1 S APCDEGPR="" Q

 S APCDEGPR=+Y

 K DIR

 S DIR(0)="9000010.16,.08",DIR("A")="Enter the number of minutes of education provided" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 I Y="" Q

EDUC11 S APCDEGC=APCDEGC+1

 S ^TMP("APCDEGP",$J,"EDUC",APCDEGC,"APCDTTOP")="`"_APCDEGPR_U_Y

 K DIC

 S DIC=200,DIC(0)="AEMQ",DIC("A")="Provider who performed the education: " D ^DIC

 I X="" W !,"none entered " G EDUC12

 I Y=-1 W !,"none entered " G EDUC12

 S $P(^TMP("APCDEGP",$J,"EDUC",APCDEGC,"APCDTTOP"),U,3)=+Y

EDUC12 ;OBJECTIVES

 W !!,"Note: if you enter objectives met, the objectives must be the "

 W !,"same for each patient in the group.",!

 S DIR(0)="9000010.16,.14",DIR("A")="Enter the Objectives Met" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G EDUCX

 I Y="" G EDUCX

 S $P(^TMP("APCDEGP",$J,"EDUC",APCDEGC,"APCDTTOP"),U,4)=Y

EDUCX ;

 G EDUC1

APCDEGP0  ; IHS/CMI/LAB - CONT. APCDEGP ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

POV1      ;EP;

 +1        DO ^XBFMK

 +2        WRITE !

 +3        KILL APCDLOOK,APCDTNQP,APCDTERR,APCDTSKI,X

 +4        DO ^APCDAPOV

 +5        IF $DATA(APCDTSKI)

               SET APCDPOV=""

               QUIT 

 +6        IF $DATA(APCDTERR)

               GOTO POV1

 +7        SET APCDPOV=APCDLOOK

 +8        KILL APCDLOOK

 +9        KILL DA,DIR,DIRUT,DUOUT,DTOUT,X,Y

           SET DIR("A")="PROVIDER NARRATIVE"

           SET DIR(0)="9000010.07,.04"

           DO ^DIR

           KILL DIR

 +10       IF $DATA(DIRUT)

               GOTO POV1

 +11       SET APCDEGC=APCDEGC+1

 +12       SET ^TMP("APCDEGP",$JOB,"POV",APCDEGC,"APCDTPOV")=APCDPOV_U_"`"_+Y_U_2

 +13       QUIT 

PROV1     ;EP

 +1        DO ^XBFMK

 +2        IF $DATA(^DD(9000010.06,.01,12.1))

               XECUTE ^DD(9000010.06,.01,12.1)

 +3       ;IHS/CMI/LAB - added file 200 check

           SET DIC=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:"^VA(200,",1:"^DIC(6,")

           SET DIC(0)="AEMQ"

           SET DIC("A")=$SELECT('APCDEGPS:"Enter PRIMARY Provider.: ",1:"Enter SECONDARY Provider: ")

           DO ^DIC

           KILL DIC

 +4        IF Y=-1

               SET APCDEGPR=""

               QUIT 

 +5        SET APCDEGPR=+Y

 +6        IF APCDEGPS

               SET APCDEGPC="S"

               GOTO PROV11

 +7        SET APCDEGPS=1

           SET APCDEGPC="P"

PROV11     SET APCDEGC=APCDEGC+1

 +1        SET ^TMP("APCDEGP",$JOB,"PROV",APCDEGC,"APCDTPRV")="`"_APCDEGPR_U_APCDEGPC

 +2        QUIT 

CHECK     ;EP;SEE IF PV AND PRO ENTERED CORRECTLY

 +1        IF $DATA(APCDMOD)

               QUIT 

 +2        SET APCDMPQ=1

 +3        IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,7)="E"

               QUIT 

 +4        KILL APCDNOCL

           DO ^APCDVCHK

 +5        IF APCDMODE'="M"

               IF '$DATA(^AUPNVPOV("AD",APCDVSIT))

                   WRITE !,"PV mnemonic required!",!,APCDBEEP

                   IF '$DATA(DTOUT)

                       SET APCDMPQ=0

                   QUIT 

 +6        IF APCDMODE'="M"

               IF '$DATA(^AUPNVPRV("AD",APCDVSIT))

                   WRITE !,"PRV mnemonic required!",!,APCDBEEP

                   IF '$DATA(DTOUT)

                       SET APCDMPQ=0

                   QUIT 

 +7        IF APCDMODE'="M"

               IF $DATA(APCDNOCL)

                   WRITE !,"CL mnemonic required!",!,$CHAR(7)

                   IF '$DATA(DTOUT)

                       SET APCDMPQ=0

                   KILL APCDNOCL

                   QUIT 

 +8        IF APCDMODE'="M"

               IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,3)="C"

                   IF '$DATA(^AUPNVCHS("AD",APCDVSIT))

                       WRITE !,"CHA, CHH or CHI mnemonic required with Contract Visits!",$CHAR(7)

                       IF '$DATA(DTOUT)

                           SET APCDMPQ=0

                       QUIT 

 +9        DO DEDT^APCDEA2(APCDVSIT)

           IF $PIECE(APCDPARM,U,5)="Y"

               IF '$DATA(^APCDFORM("AB",APCDVSIT))

                   SET APCDFV=APCDVSIT

                   DO ^APCDFORM

                   KILL APCDFV

 +10       QUIT 

EDUC1     ;EP;

 +1        DO ^XBFMK

 +2        IF $DATA(^DD(9000010.16,.01,12.1))

               XECUTE ^DD(9000010.16,.01,12.1)

 +3        WRITE !

 +4        SET DIC="^AUTTEDT("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter Educaton TOPIC: "

           DO ^DIC

           KILL DIC

 +5        IF Y=-1

               SET APCDEGPR=""

               QUIT 

 +6        SET APCDEGPR=+Y

 +7        KILL DIR

 +8        SET DIR(0)="9000010.16,.08"

           SET DIR("A")="Enter the number of minutes of education provided"

           KILL DA

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               QUIT 

 +10       IF Y=""

               QUIT 

EDUC11     SET APCDEGC=APCDEGC+1

 +1        SET ^TMP("APCDEGP",$JOB,"EDUC",APCDEGC,"APCDTTOP")="`"_APCDEGPR_U_Y

 +2        KILL DIC

 +3        SET DIC=200

           SET DIC(0)="AEMQ"

           SET DIC("A")="Provider who performed the education: "

           DO ^DIC

 +4        IF X=""

               WRITE !,"none entered "

               GOTO EDUC12

 +5        IF Y=-1

               WRITE !,"none entered "

               GOTO EDUC12

 +6        SET $PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGC,"APCDTTOP"),U,3)=+Y

EDUC12    ;OBJECTIVES

 +1        WRITE !!,"Note: if you enter objectives met, the objectives must be the "

 +2        WRITE !,"same for each patient in the group.",!

 +3        SET DIR(0)="9000010.16,.14"

           SET DIR("A")="Enter the Objectives Met"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO EDUCX

 +5        IF Y=""

               GOTO EDUCX

 +6        SET $PIECE(^TMP("APCDEGP",$JOB,"EDUC",APCDEGC,"APCDTTOP"),U,4)=Y

EDUCX     ;

 +1        GOTO EDUC1