APCDEA.m

APCDEA ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;

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

 ;PATCH 2 commented out writing of date

 ;

 ; APCDFLG=0 ... RUN

 ; APCDFLG=1 ... ERROR

 ;

 ; APCDMODE=A ... ADD

 ; APCDMODE=M ... MOD

 ;

HDR ; Write Header

 W:$D(IOF) @IOF

 I $D(APCDMINI) F APCDJ=7:1:11 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX

 I '$D(APCDMINI) F APCDJ=1:1:5 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX

 K APCDX,APCDJ,APCDEXIT

 W !!

 D ^APCDEIN

 Q:APCDFLG

 S APCDTPLT("NAME")="MNEMONIC",APCDTPLT=0,APCDLOC="" F  D GETLOC Q:APCDLOC=""  S APCDTYPE="" F  D GETTYPE Q:APCDTYPE=""  S APCDCAT="" F  D GETCAT Q:APCDCAT=""  D RESTOFIT

 D EOJ

 Q

 ;

RESTOFIT S APCDDATE="" F  D GETDATE Q:APCDDATE=""  S APCDPAT="" D GETPAT D:APCDPAT]"" PROCESS

 Q

 ;

GETTMPLT ; GET TEMPLATE

 Q

 ;

GETLOC ; GET LOCATION OF ENCOUNTER

 Q:$D(APCDEXIT)

 ;S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)

 S APCDLOC=""

 I $G(APCDDEFL) S DIC("B")=APCDDEFL,DIC(0)="AMEBQN",DIC="^AUTTLOC(" D ^DIC K DIC

 I '$G(APCDDEFL) S DIC(0)="AEMQ",DIC="^AUTTLOC(" D ^DIC K DIC

 ;S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 I $P(^AUTTLOC(+Y,0),U,21)]"" W !!,"That location has been inactivated!  See you supervisor." G GETLOC

 S APCDLOC=+Y

 Q

 ;

GETTYPE ; GET TYPE OF ENCOUNTER

 Q:$D(APCDEXIT)

 S APCDTYPE=""

 K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 I $D(APCDDEFT),APCDDEFT]"" S DIR("B")=APCDDEFT

 S DIR(0)="9000010,.03O",DIR("A")="TYPE" D ^DIR K DIR

 I $D(DIRUT) S X="" Q

 S APCDTYPE=Y

 Q

 ;

GETCAT ; GET SERVICE CATEGORY

 Q:$D(APCDEXIT)

 S APCDCAT=""

 K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 I $D(APCDDEFS),APCDDEFS]"" S DIR("B")=APCDDEFS

 S DIR(0)="9000010,.07O",DIR("A")="SERVICE CATEGORY" D ^DIR K DIR

 I $D(DIRUT) S X="" Q

 S APCDCAT=Y

 Q

 ;

GETDATE ; GET DATE OF ENCOUNTER

 Q:$D(APCDEXIT)

 S:APCDDATE APCDODAT=APCDDATE\1

 S APCDDATE=""

 W !!,"VISIT/ADMIT DATE: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X=""

 Q:X=""!(X="^")

 I X="^^" S (APCDDATE,APCDLOC,APCDCAT,APCDTYPE,APCDEXIT)="" Q

 I X=" ",$D(APCDODAT),APCDODAT]"" S X=APCDODAT ;W X

 I X["@" W "  <Date only, please - no time specification>",$C(7),$C(7) K X G GETDATE  ;IHS/NPO/MAW - 12/13/05 ADDED LINE TO CORRECT IF USER PUT IN A DATE WITH TIME VICE DATE ONLY

 S %DT="ET" D ^%DT G:Y<0 GETDATE

 I Y>DT W "  <Future dates not allowed>",$C(7),$C(7) K X G GETDATE

 K APCDODAT

 S APCDDATE=X

GETTIME ;

 S APCDTIME=""

 I APCDTYPE="C"!("CNT"[APCDCAT) S APCDTIME="12:00"

 W !,"TIME OF VISIT: ",$S(APCDTIME]"":APCDTIME_"// ",1:"") R X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" S:X="" X=APCDTIME

 S APCDTIME=""

 I X="^" S APCDDATE="" Q

 I X="" W APCDBEEP,"  Time Required!" G GETTIME

 I X["?" W !,"Enter time of visit, or 'D' for default." G GETTIME

 I X="D" S X="12:00" W "  ",X

EDTIME S APCDTIME=X,X=APCDDATE_"@"_APCDTIME

 X ^TMP("APCD",$J,"APCDDATE")

 I '$D(X) W APCDBEEP G GETDATE

 I X="-1" W ! G GETDATE

 S APCDDATE=X

 Q

GETPAT ;EP - GET PATIENT

 W !

 S APCDPAT=""

 I $G(APCDCAF("IN CAF W/PATIENT")) S APCDPAT=APCDCAF("IN CAF W/PATIENT") S Y=APCDPAT D ^AUPNPAT Q

 I '$P($G(^APCDSITE(DUZ(2),0)),U,34) S AUPNLK("INAC")=1

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 I $D(APCDPARM),$P(APCDPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1

 S APCDPAT=+Y

 D INAC(APCDPAT,.X) I 'X S APCDPAT="" Q

 I DUZ("AG")="I" D ^APCDEMDI I $D(^APCDSITE(DUZ(2),11)) D ^APCDECC

 Q

 ;

PROCESS ; PROCESS PATIENT

 D ^APCDEA2

 I $D(APCDAPP) W !!,"Returning to Add Mode.",! K APCDAPP

 Q

 ;

EOJ ; END OF JOB

 D ^APCDEKL

 Q

INAC(P,RETVAL) ;EP - called to check to see if patient is inactive

 S RETVAL=1

 I $P($G(^AUPNPAT(P,41,DUZ(2),0)),U,3)]"" D  Q

 .W !!,"***Warning***  You have selected a patient with an Inactive Chart.",!

 .K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue to add data for this patient",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) S RETVAL=0

 .S RETVAL=Y

 Q

TEXT ;

 ;;PCC Data Entry Module

 ;;

 ;;**************

 ;;* ENTER Mode *

 ;;**************

 ;;

 ;;PCC Data Entry Module

 ;;

 ;;********************

 ;;* Mini  ENTER Mode *

 ;;********************

APCDEA    ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;

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

 +2       ;PATCH 2 commented out writing of date

 +3       ;

 +4       ; APCDFLG=0 ... RUN

 +5       ; APCDFLG=1 ... ERROR

 +6       ;

 +7       ; APCDMODE=A ... ADD

 +8       ; APCDMODE=M ... MOD

 +9       ;

HDR       ; Write Header

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        IF $DATA(APCDMINI)

               FOR APCDJ=7:1:11

                   SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)

                   WRITE !?80-$LENGTH(APCDX)\2,APCDX

 +3        IF '$DATA(APCDMINI)

               FOR APCDJ=1:1:5

                   SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)

                   WRITE !?80-$LENGTH(APCDX)\2,APCDX

 +4        KILL APCDX,APCDJ,APCDEXIT

 +5        WRITE !!

 +6        DO ^APCDEIN

 +7        IF APCDFLG

               QUIT 

 +8        SET APCDTPLT("NAME")="MNEMONIC"

           SET APCDTPLT=0

           SET APCDLOC=""

           FOR 

               DO GETLOC

               IF APCDLOC=""

                   QUIT 

               SET APCDTYPE=""

               FOR 

                   DO GETTYPE

                   IF APCDTYPE=""

                       QUIT 

                   SET APCDCAT=""

                   FOR 

                       DO GETCAT

                       IF APCDCAT=""

                           QUIT 

                       DO RESTOFIT

 +9        DO EOJ

 +10       QUIT 

 +11      ;

RESTOFIT   SET APCDDATE=""

           FOR 

               DO GETDATE

               IF APCDDATE=""

                   QUIT 

               SET APCDPAT=""

               DO GETPAT

               IF APCDPAT]""

                   DO PROCESS

 +1        QUIT 

 +2       ;

GETTMPLT  ; GET TEMPLATE

 +1        QUIT 

 +2       ;

GETLOC    ; GET LOCATION OF ENCOUNTER

 +1        IF $DATA(APCDEXIT)

               QUIT 

 +2       ;S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)

 +3        SET APCDLOC=""

 +4        IF $GET(APCDDEFL)

               SET DIC("B")=APCDDEFL

               SET DIC(0)="AMEBQN"

               SET DIC="^AUTTLOC("

               DO ^DIC

               KILL DIC

 +5        IF '$GET(APCDDEFL)

               SET DIC(0)="AEMQ"

               SET DIC="^AUTTLOC("

               DO ^DIC

               KILL DIC

 +6       ;S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC

 +7        IF Y<0

               QUIT 

 +8        IF $PIECE(^AUTTLOC(+Y,0),U,21)]""

               WRITE !!,"That location has been inactivated!  See you supervisor."

               GOTO GETLOC

 +9        SET APCDLOC=+Y

 +10       QUIT 

 +11      ;

GETTYPE   ; GET TYPE OF ENCOUNTER

 +1        IF $DATA(APCDEXIT)

               QUIT 

 +2        SET APCDTYPE=""

 +3        KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 +4        IF $DATA(APCDDEFT)

               IF APCDDEFT]""

                   SET DIR("B")=APCDDEFT

 +5        SET DIR(0)="9000010,.03O"

           SET DIR("A")="TYPE"

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               SET X=""

               QUIT 

 +7        SET APCDTYPE=Y

 +8        QUIT 

 +9       ;

GETCAT    ; GET SERVICE CATEGORY

 +1        IF $DATA(APCDEXIT)

               QUIT 

 +2        SET APCDCAT=""

 +3        KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA

 +4        IF $DATA(APCDDEFS)

               IF APCDDEFS]""

                   SET DIR("B")=APCDDEFS

 +5        SET DIR(0)="9000010,.07O"

           SET DIR("A")="SERVICE CATEGORY"

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               SET X=""

               QUIT 

 +7        SET APCDCAT=Y

 +8        QUIT 

 +9       ;

GETDATE   ; GET DATE OF ENCOUNTER

 +1        IF $DATA(APCDEXIT)

               QUIT 

 +2        IF APCDDATE

               SET APCDODAT=APCDDATE\1

 +3        SET APCDDATE=""

 +4        WRITE !!,"VISIT/ADMIT DATE: "

           READ X:$SELECT($DATA(DTIME):DTIME,1:300)

           IF '$TEST

               SET X=""

 +5        IF X=""!(X="^")

               QUIT 

 +6        IF X="^^"

               SET (APCDDATE,APCDLOC,APCDCAT,APCDTYPE,APCDEXIT)=""

               QUIT 

 +7       ;W X

           IF X=" "

               IF $DATA(APCDODAT)

                   IF APCDODAT]""

                       SET X=APCDODAT

 +8       ;IHS/NPO/MAW - 12/13/05 ADDED LINE TO CORRECT IF USER PUT IN A DATE WITH TIME VICE DATE ONLY

           IF X["@"

               WRITE "  <Date only, please - no time specification>",$CHAR(7),$CHAR(7)

               KILL X

               GOTO GETDATE

 +9        SET %DT="ET"

           DO ^%DT

           IF Y<0

               GOTO GETDATE

 +10       IF Y>DT

               WRITE "  <Future dates not allowed>",$CHAR(7),$CHAR(7)

               KILL X

               GOTO GETDATE

 +11       KILL APCDODAT

 +12       SET APCDDATE=X

GETTIME   ;

 +1        SET APCDTIME=""

 +2        IF APCDTYPE="C"!("CNT"[APCDCAT)

               SET APCDTIME="12:00"

 +3        WRITE !,"TIME OF VISIT: ",$SELECT(APCDTIME]"":APCDTIME_"// ",1:"")

           READ X:$SELECT($DATA(DTIME):DTIME,1:300)

           IF '$TEST

               SET X="^"

           IF X=""

               SET X=APCDTIME

 +4        SET APCDTIME=""

 +5        IF X="^"

               SET APCDDATE=""

               QUIT 

 +6        IF X=""

               WRITE APCDBEEP,"  Time Required!"

               GOTO GETTIME

 +7        IF X["?"

               WRITE !,"Enter time of visit, or 'D' for default."

               GOTO GETTIME

 +8        IF X="D"

               SET X="12:00"

               WRITE "  ",X

EDTIME     SET APCDTIME=X

           SET X=APCDDATE_"@"_APCDTIME

 +1        XECUTE ^TMP("APCD",$JOB,"APCDDATE")

 +2        IF '$DATA(X)

               WRITE APCDBEEP

               GOTO GETDATE

 +3        IF X="-1"

               WRITE !

               GOTO GETDATE

 +4        SET APCDDATE=X

 +5        QUIT 

GETPAT    ;EP - GET PATIENT

 +1        WRITE !

 +2        SET APCDPAT=""

 +3        IF $GET(APCDCAF("IN CAF W/PATIENT"))

               SET APCDPAT=APCDCAF("IN CAF W/PATIENT")

               SET Y=APCDPAT

               DO ^AUPNPAT

               QUIT 

 +4        IF '$PIECE($GET(^APCDSITE(DUZ(2),0)),U,34)

               SET AUPNLK("INAC")=1

 +5        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +6        IF Y<0

               QUIT 

 +7        IF $DATA(APCDPARM)

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

                   WRITE !?25,"Ok"

                   SET %=1

                   DO YN^DICN

                   IF %'=1

                       QUIT 

 +8        SET APCDPAT=+Y

 +9        DO INAC(APCDPAT,.X)

           IF 'X

               SET APCDPAT=""

               QUIT 

 +10       IF DUZ("AG")="I"

               DO ^APCDEMDI

               IF $DATA(^APCDSITE(DUZ(2),11))

                   DO ^APCDECC

 +11       QUIT 

 +12      ;

PROCESS   ; PROCESS PATIENT

 +1        DO ^APCDEA2

 +2        IF $DATA(APCDAPP)

               WRITE !!,"Returning to Add Mode.",!

               KILL APCDAPP

 +3        QUIT 

 +4       ;

EOJ       ; END OF JOB

 +1        DO ^APCDEKL

 +2        QUIT 

INAC(P,RETVAL) ;EP - called to check to see if patient is inactive

 +1        SET RETVAL=1

 +2        IF $PIECE($GET(^AUPNPAT(P,41,DUZ(2),0)),U,3)]""

               Begin DoDot:1

 +3                WRITE !!,"***Warning***  You have selected a patient with an Inactive Chart.",!

 +4                KILL DIR

                   SET DIR(0)="Y"

                   SET DIR("A")="Do you wish to continue to add data for this patient"

                   SET DIR("B")="Y"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +5                IF $DATA(DIRUT)

                       SET RETVAL=0

 +6                SET RETVAL=Y

               End DoDot:1

               QUIT 

 +7        QUIT 

TEXT      ;

 +1       ;;PCC Data Entry Module

 +2       ;;

 +3       ;;**************

 +4       ;;* ENTER Mode *

 +5       ;;**************

 +6       ;;

 +7       ;;PCC Data Entry Module

 +8       ;;

 +9       ;;********************

 +10      ;;* Mini  ENTER Mode *

 +11      ;;********************