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
