APCDPE2.m

APCDPE2 ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;

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

 ;   Generate VISIT, then process MNEMONICS/TEMPLATE

 ;

START ;

 S Y=APCDPAT D ^AUPNPAT

 S APCDCLN=APCDPECL

 K APCDALVR D ^APCDALV

 I $D(APCDAFLG)#2,APCDAFLG=2 W $C(7),!,"VISIT date not valid for current patient!",! S APCDFLG=1 Q

 Q:APCDVSIT=""

 S APCDLVST=APCDVSIT

 S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE

 S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT

 I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X

 K DR

 I $P($G(APCDPARM),U,18)'="N" S APCDVDSP=APCDVSIT D:$D(APCDVSIT("NEW")) ^APCDVDSP D:'$D(APCDVSIT("NEW")) ^APCDEWHA K APCDVDSP

 I APCDTYPE'="C","TC"'[APCDCAT,'$D(APCDVSIT("NEW")) S X="TM" D GET1

 I $P($G(APCDPARM),U,16)="Y",$E($P(^AUTTLOC(APCDLOC,0),U,10),5,6)>49 S X="OLOC" D GET1

 I APCDCAT="H",APCDTYPE'="C",'$D(^AUPNVINP("AD",APCDVSIT)) S X="IP" D GET1

 S APCDPEH=0 F  S APCDPEH=$O(APCDCSEL(APCDPEH)) Q:APCDPEH'=+APCDPEH  S X=APCDCSEL(APCDPEH),X=$P(^APCDTKW(X,0),U) D GET1

 W !!,"You may now enter other data using any of the data entry mnemonics.",!,"To display the visit type DISP, to display a health summary type DHS.",!,"Press enter to exit.",!

 D MNEPROC

 Q

 ;

MNEPROC ; PROCESS MNEMONICS UNTIL DONE

 S APCDMPQ=0

 F  D GETMNE Q:APCDMPQ

 I $G(APCDVSIT) D EP^APCDKDE

 D GETMNEK

 K APCDMPQ,APCDREGU

 W !

 Q

 ;

GETMNE ; GET MNEMONIC

 W !

 S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(0),U))<5" D ^DIC K DIC("A"),DIC("S")

 I Y<0 D CHECK Q

 S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)

 K APCDMOD

 D ^APCDEA3

 I $D(APCDEQX) D ^APCDEQX I $D(APCDEQX) S APCDMPQ=1 Q

 I $D(APCDMOD) W !!,"Switching to Modify Mode for ONE Mnemonic ONLY!" S APCDMODE="M",APCDVSIT=APCDLVST,APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q

 Q

 ;

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDVSIT,APCDX,APCDEQX,APCDREGU

 Q

 ;

CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY

 Q:$D(APCDMOD)

 S APCDMPQ=1

 K APCDNOCL D ^APCDVCHK

 Q:"EX"[$P(^AUPNVSIT(APCDVSIT,0),U,7)

 I APCDMODE'="M",'$D(^AUPNVPOV("AD",APCDVSIT)),'$D(^AUPNVPRN("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,7)="H",$P(^(0),U,3)'="C",'$D(^AUPNVINP("AD",APCDVSIT)) W !,"IP Mnemonic required on Hospitalizations!",$C(7) S:'$D(DTOUT) APCDMPQ=0 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

 Q:'APCDMPQ

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

 I $P(APCDPARM,U,5)="Y",$D(^AUPNVTC("AD",APCDVSIT)) S APCDFV=APCDVSIT D ^APCDFCTC K APCDFV ;IHS/CMI/LAB - patch 2 added this line to do tc tracking

 Q

 ;

GET1 ;

 W !!

 S DIC="^APCDTKW(",DIC(0)="EMQX" D ^DIC K DIC

 I Y<0 W !!,$C(7),$C(7),X," Mnemonic is Missing - Notify your Supervisor!" K DIC,X Q

 S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)

 D ^APCDEA3

 Q

 ;

APCDPE2   ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;

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

 +2       ;   Generate VISIT, then process MNEMONICS/TEMPLATE

 +3       ;

START     ;

 +1        SET Y=APCDPAT

           DO ^AUPNPAT

 +2        SET APCDCLN=APCDPECL

 +3        KILL APCDALVR

           DO ^APCDALV

 +4        IF $DATA(APCDAFLG)#2

               IF APCDAFLG=2

                   WRITE $CHAR(7),!,"VISIT date not valid for current patient!",!

                   SET APCDFLG=1

                   QUIT 

 +5        IF APCDVSIT=""

               QUIT 

 +6        SET APCDLVST=APCDVSIT

 +7        SET DIE="^AUPNPAT("

           SET DR=".16///TODAY"

           SET DA=APCDPAT

           DO ^DIE

 +8        SET AUPNVSIT=APCDVSIT

           DO MOD^AUPNVSIT

 +9        IF AUPNDOB]""

               SET X2=AUPNDOB

               SET X1=APCDDATE

               DO ^%DTC

               SET AUPNDAYS=X

 +10       KILL DR

 +11       IF $PIECE($GET(APCDPARM),U,18)'="N"

               SET APCDVDSP=APCDVSIT

               IF $DATA(APCDVSIT("NEW"))

                   DO ^APCDVDSP

               IF '$DATA(APCDVSIT("NEW"))

                   DO ^APCDEWHA

               KILL APCDVDSP

 +12       IF APCDTYPE'="C"

               IF "TC"'[APCDCAT

                   IF '$DATA(APCDVSIT("NEW"))

                       SET X="TM"

                       DO GET1

 +13       IF $PIECE($GET(APCDPARM),U,16)="Y"

               IF $EXTRACT($PIECE(^AUTTLOC(APCDLOC,0),U,10),5,6)>49

                   SET X="OLOC"

                   DO GET1

 +14       IF APCDCAT="H"

               IF APCDTYPE'="C"

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

                       SET X="IP"

                       DO GET1

 +15       SET APCDPEH=0

           FOR 

               SET APCDPEH=$ORDER(APCDCSEL(APCDPEH))

               IF APCDPEH'=+APCDPEH

                   QUIT 

               SET X=APCDCSEL(APCDPEH)

               SET X=$PIECE(^APCDTKW(X,0),U)

               DO GET1

 +16       WRITE !!,"You may now enter other data using any of the data entry mnemonics.",!,"To display the visit type DISP, to display a health summary type DHS.",!,"Press enter to exit.",!

 +17       DO MNEPROC

 +18       QUIT 

 +19      ;

MNEPROC   ; PROCESS MNEMONICS UNTIL DONE

 +1        SET APCDMPQ=0

 +2        FOR 

               DO GETMNE

               IF APCDMPQ

                   QUIT 

 +3        IF $GET(APCDVSIT)

               DO EP^APCDKDE

 +4        DO GETMNEK

 +5        KILL APCDMPQ,APCDREGU

 +6        WRITE !

 +7        QUIT 

 +8       ;

GETMNE    ; GET MNEMONIC

 +1        WRITE !

 +2        SET DIC="^APCDTKW("

           SET DIC(0)="AEMQ"

           SET DIC("A")="MNEMONIC: "

           SET DIC("S")="I $L($P(^(0),U))<5"

           DO ^DIC

           KILL DIC("A"),DIC("S")

 +3        IF Y<0

               DO CHECK

               QUIT 

 +4        SET APCDMNE=+Y

           SET APCDMNE("NAME")=$PIECE(Y,U,2)

 +5        KILL APCDMOD

 +6        DO ^APCDEA3

 +7        IF $DATA(APCDEQX)

               DO ^APCDEQX

               IF $DATA(APCDEQX)

                   SET APCDMPQ=1

                   QUIT 

 +8        IF $DATA(APCDMOD)

               WRITE !!,"Switching to Modify Mode for ONE Mnemonic ONLY!"

               SET APCDMODE="M"

               SET APCDVSIT=APCDLVST

               SET APCDVLK=APCDVSIT

               DO GETMNE

               KILL APCDVLK,APCDMOD

               SET APCDMODE="A"

               WRITE !!,"Switching back to ENTER Mode!"

               QUIT 

 +9        QUIT 

 +10      ;

GETMNEK   ; KILL GETMNE SPECIFIC VARIABLES

 +1        KILL APCDVSIT,APCDX,APCDEQX,APCDREGU

 +2        QUIT 

 +3       ;

CHECK     ; SEE IF PV AND PRO ENTERED CORRECTLY

 +1        IF $DATA(APCDMOD)

               QUIT 

 +2        SET APCDMPQ=1

 +3        KILL APCDNOCL

           DO ^APCDVCHK

 +4        IF "EX"[$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)

               QUIT 

 +5        IF APCDMODE'="M"

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

                   IF '$DATA(^AUPNVPRN("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,7)="H"

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

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

                           WRITE !,"IP Mnemonic required on Hospitalizations!",$CHAR(7)

                           IF '$DATA(DTOUT)

                               SET APCDMPQ=0

                           QUIT 

 +9        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 

 +10       IF 'APCDMPQ

               QUIT 

 +11       DO DEDT^APCDEA2(APCDLVST)

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

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

                   SET APCDFV=APCDLVST

                   DO ^APCDFORM

                   KILL APCDFV

 +12      ;IHS/CMI/LAB - patch 2 added this line to do tc tracking

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

               IF $DATA(^AUPNVTC("AD",APCDVSIT))

                   SET APCDFV=APCDVSIT

                   DO ^APCDFCTC

                   KILL APCDFV

 +13       QUIT 

 +14      ;

GET1      ;

 +1        WRITE !!

 +2        SET DIC="^APCDTKW("

           SET DIC(0)="EMQX"

           DO ^DIC

           KILL DIC

 +3        IF Y<0

               WRITE !!,$CHAR(7),$CHAR(7),X," Mnemonic is Missing - Notify your Supervisor!"

               KILL DIC,X

               QUIT 

 +4        SET APCDMNE=+Y

           SET APCDMNE("NAME")=$PIECE(Y,U,2)

 +5        DO ^APCDEA3

 +6        QUIT 

 +7       ;