Routine: APCDEAPC

APCDEAPC ; IHS/CMI/LAB - ENTRY OF DATA FROM APC FORMS ;

 ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18

 ;FILE 200 CONV

HDR ; Write Header

 W:$D(IOF) @IOF

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

 K APCDX,APCDJ

 W !!

 D ^APCDEIN S APCDTPLT=0

 Q:APCDFLG

PROC ;

 D GETLOC

 G:APCDLOC="" EOJ

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

 D EOJ

GETLOC ; GET LOCATION OF ENCOUNTER

 S APCDLOC="",APCDTYPE="",APCDCAT=""

 S APCDTYPE=$P(APCDPARM,U,11) I APCDTYPE="" W !!,"Default TYPE FOF VISIT NOT in Site Parameter File",$C(7),$C(7) H 4 Q

 S APCDCAT="A"

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

 S DIC("A")="Enter LOCATION of VISIT......: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y<0

 S APCDLOC=+Y

GETDATE ; GET DATE OF ENCOUNTER

 S APCDDATE=""

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

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

 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

 S (APCDDATE,APCDHDAT)=Y

GETPAT ; GET PATIENT

 S APCDDATE=APCDHDAT

 W:$D(IOF) @IOF W !!,"Entering forms for ",$P(^DIC(4,APCDLOC,0),U)," for visit date ",$$FMTE^XLFDT(APCDDATE,1)

 S APCDPAT=""

 S DIC("A")="Enter PATIENT NAME...........: ",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

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

PROCESS ; PROCESS PATIENT

TIME ;

 S DIR(0)="SB^1:8AM - NOON;2:NOON - 5PM;3:5PM - 10PM;4:10PM - 8AM",DIR("A")="Enter TIME OF DAY" K DA D ^DIR K DIR

 I $D(DIRUT) W !,"Time is required",!! Q

 S APCDDATE=APCDDATE_"."_$S(Y=1:"08",Y=2:12,Y=3:17,Y=4:22,1:12)

CLINIC ;

 K DIC S DIC(0)="AEMQ",DIC="^DIC(40.7,",DIC("A")="Enter TYPE OF CLINIC CODE....: " D ^DIC K DIC

 I Y<0 W !!,"Clinic is required",!! H 2 Q

 ;S DIR(0)="9000010,.08",DIR("A")="Enter TYPE OF CLINIC CODE...." K DA D ^DIR K DIR

 ;I $D(DIRUT) W !!,"Clinic is required",!! Q

 S APCDCLN="`"_+Y

 D VISIT

VISIT ; create visit

 ;W !!,"Creating PCC Visit for ",$P(^DPT(APCDPAT,0),U)," on ",$$FMTE^XLFDT(APCDDATE,"1P"),!!

 S X=$$FMTE^XLFDT(APCDDATE,1) X $P(^DD(9000010,.01,0),U,5,99)

 I '$D(X) W !!,"Visit information NOT correct for this patient.",!,$C(7),$C(7) H 3 Q

 K APCDALVR

 D ^APCDALV

 I $D(APCDALVR("APCDAFLG")) W !!,$C(7),$C(7),"Visit creation failed!!",! Q

 I '$G(APCDVSIT) W !!,"No visit selected!!" Q

 ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")>$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR

 ;above added for EHR and auditing of visits, d/e created

 K APCDALVR

 D PROVIDER

 I '$$PRIMPROV^APCLV(APCDVSIT,"I") W !!,$C(7),$C(7),"Primary Provider Not Entered correctly.  Deleting incomplete visit.",! H 5 D DELETE Q

 D APCPOV

 I '$$PRIMPOV^APCLV(APCDVSIT,"I") W !!,$C(7),$C(7),"Purpose of Visit Not Entered correctly.  Deleting incomplete visit.",! H 5 D DELETE Q

 D MNEPROC

MNEPROC ; PROCESS MNEMONICS UNTIL DONE

 W !!,"You may now enter any other information using the PCC mnemonics.",!

 S APCDMPQ=0

 F  D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q

 D GETMNEK

 K APCDMPQ

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^APCDEGP0 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",APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDVSIT,APCDEGX,APCDEQX

APCPOV ;get APC RECODES AND FILE

 K APCDALVR

 S DIC="^AUTTRCD(",DIC(0)="AEMQ",DIC("A")="Enter APC CODE...............: " D ^DIC K DIC,DA

 I Y=-1&((X="")!(X="^"))&('$$PRIMPOV^APCLV(APCDVSIT,"I")) G ICDPOV

 Q:Y=-1

 S APCDAPCC=$P(Y,U,2),APCDAPC=+Y I APCDAPCC>699&(APCDAPCC<800) D INJ

 S APCDICD=$P(^AUTTRCD(APCDAPC,0),U,6) I APCDICD="" W !!,$C(7),$C(7),"NO ICD CODE ASSOCIATED WITH APC CODE ",APCDAPCC H 3 Q

 S APCDALVR("APCDTPOV")=APCDICD

 S APCDALVR("APCDVSIT")=APCDVSIT,APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]",APCDALVR("APCDPAT")=APCDPAT

 S APCDALVR("APCDTNQ")=$P(^AUTTRCD(APCDAPC,0),U,3)

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) W !!,$C(7),$C(7),"Creating V Provider failed..."

 G APCPOV

ICDPOV ;

 K APCDALVR

 S DIC="^APCDTKW(",DIC(0)="E",X="IPV" D ^DIC K DIC,DA

 I Y=-1 W !!,$C(7),$C(7),"Can't find IPV mnemonic!!",! H 4 Q

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

 D ^APCDEA3

PROVIDER ;

 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('$$PRIMPROV^APCLV(APCDVSIT,"I"):"Enter PRIMARY Provider.......: ",1:"Enter OTHER Provider.........: ") D ^DIC K DIC

 Q:Y=-1

PROV11 ;

 S APCDALVR("APCDTPRO")="`"_+Y

 S APCDALVR("APCDVSIT")=APCDVSIT,APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]",APCDALVR("APCDPAT")=APCDPAT

 S APCDALVR("APCDTPS")=$S($$PRIMPROV^APCLV(APCDVSIT,"I"):"S",1:"P")

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) W !!,$C(7),$C(7),"Creating V Provider failed..."

 G PROVIDER

INJ ;

CAUSE ;

 S DIC="^AUTTRIJ(",DIC(0)="AEMQ",DIC("A")="Enter EXTERNAL CAUSE OF INJURY: " D ^DIC K DA,DIC

 I Y=-1 W !,"NO External Cause entered.",! G PLACE

 S APCDALVR("APCDTCI")=$P(^AUTTRIJ(+Y,0),U,3)

 S APCDALVR("APCDTFR")="F"

PLACE ;

 S DIR(0)="9000010.07,.11",DIR("A")="Enter PLACE OF INJURY" K DA D ^DIR K DIR

 G:$D(DIRUT) CAUSEDX

 G:Y="" CAUSEDX

 S APCDALVR("APCDTPA")=Y

CAUSEDX ;

 S DIR(0)="9000010.07,.07",DIR("A")="Enter CAUSE OF DX (if alcohol related)" K DA D ^DIR K DIR

W !

 Q:$D(DIRUT)

 Q:Y=""

 S APCDALVR("APCDTCD")=Y

DELETE ;

 S APCDVDLT=APCDVSIT D ^APCDVDLT

 W !!,"Deleted.",!

EOJ ; END OF JOB

 D KILL^AUPNPAT

 K APCDVSIT,APCDAPC,APCDAPCC,APCDHDAT,APCDDATE,APCDLOC,APCDTYPE,APCDCAT,APCDMNE,APCDALVR,APCDICD,APCDRV,APCDTCB,APCDTCM,APCDTORH

 D ^APCDEKL

TEXT ;

 ;;PCC Data Entry Module

;;

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

 ;;* APC FORM ENTRY Mode *

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

;;

APCDEAPC  ; IHS/CMI/LAB - ENTRY OF DATA FROM APC FORMS ;

 +1       ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18

 +2       ;FILE 200 CONV

 +3       ;

 +4       ;

 +5       ;

HDR       ; Write Header

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        FOR APCDJ=1:1:5

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

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

 +3        KILL APCDX,APCDJ

 +4        WRITE !!

 +5        DO ^APCDEIN

           SET APCDTPLT=0

 +6        IF APCDFLG

               QUIT

PROC      ;

 +1        DO GETLOC

 +2        IF APCDLOC=""

               GOTO EOJ

 +3        SET APCDDATE=""

FOR

               DO GETDATE

               IF APCDDATE=""

                   QUIT

FOR

                   SET APCDPAT=""

                   DO GETPAT

                   IF APCDPAT=""

                       QUIT

                   DO PROCESS

 +4        DO EOJ

 +5        QUIT

 +6       ;

 +7       ;

 +8       ;

GETLOC    ; GET LOCATION OF ENCOUNTER

 +1        SET APCDLOC=""

           SET APCDTYPE=""

           SET APCDCAT=""

 +2        SET APCDTYPE=$PIECE(APCDPARM,U,11)

           IF APCDTYPE=""

               WRITE !!,"Default TYPE FOF VISIT NOT in Site Parameter File",$CHAR(7),$CHAR(7)

               HANG 4

               QUIT

 +3        SET APCDCAT="A"

 +4        SET APCDLOC=""

           IF $DATA(APCDDEFL)

               IF APCDDEFL]""

                   SET DIC("B")=$PIECE(^DIC(4,APCDDEFL,0),U)

 +5        SET DIC("A")="Enter LOCATION of VISIT......: "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +6        IF Y<0

               QUIT

 +7        SET APCDLOC=+Y

 +8        QUIT

 +9       ;

 +10      ;

GETDATE   ; GET DATE OF ENCOUNTER

 +1        SET APCDDATE=""

 +2        WRITE !,"Enter VISIT DATE.............: "

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

           IF '$TEST

               SET X=""

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

               QUIT

 +4        SET %DT="ET"

           DO ^%DT

           IF Y<0

               GOTO GETDATE

 +5        IF Y>DT

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

               KILL X

               GOTO GETDATE

 +6        SET (APCDDATE,APCDHDAT)=Y

 +7        QUIT

GETPAT    ; GET PATIENT

 +1        SET APCDDATE=APCDHDAT

 +2        IF $DATA(IOF)

               WRITE @IOF

           WRITE !!,"Entering forms for ",$PIECE(^DIC(4,APCDLOC,0),U)," for visit date ",$$FMTE^XLFDT(APCDDATE,1)

 +3        SET APCDPAT=""

 +4        SET DIC("A")="Enter PATIENT NAME...........: "

           SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +5        IF Y<0

               QUIT

 +6        IF $DATA(APCDPARM)

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

                   WRITE !?25,"Ok"

                   SET %=1

                   DO YN^DICN

                   IF %'=1

                       QUIT

 +7        SET APCDPAT=+Y

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

               DO ^APCDEMDI

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

                   DO ^APCDECC

 +9        QUIT

 +10      ;

PROCESS   ; PROCESS PATIENT

TIME      ;

 +1        SET DIR(0)="SB^1:8AM - NOON;2:NOON - 5PM;3:5PM - 10PM;4:10PM - 8AM"

           SET DIR("A")="Enter TIME OF DAY"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               WRITE !,"Time is required",!!

               QUIT

 +3        SET APCDDATE=APCDDATE_"."_$SELECT(Y=1:"08",Y=2:12,Y=3:17,Y=4:22,1:12)

CLINIC    ;

 +1        KILL DIC

           SET DIC(0)="AEMQ"

           SET DIC="^DIC(40.7,"

           SET DIC("A")="Enter TYPE OF CLINIC CODE....: "

           DO ^DIC

           KILL DIC

 +2        IF Y<0

               WRITE !!,"Clinic is required",!!

               HANG 2

               QUIT

 +3       ;S DIR(0)="9000010,.08",DIR("A")="Enter TYPE OF CLINIC CODE...." K DA D ^DIR K DIR

 +4       ;I $D(DIRUT) W !!,"Clinic is required",!! Q

 +5        SET APCDCLN="`"_+Y

 +6        DO VISIT

 +7        QUIT

 +8       ;

VISIT     ; create visit

 +1       ;W !!,"Creating PCC Visit for ",$P(^DPT(APCDPAT,0),U)," on ",$$FMTE^XLFDT(APCDDATE,"1P"),!!

 +2        SET X=$$FMTE^XLFDT(APCDDATE,1)

           XECUTE $PIECE(^DD(9000010,.01,0),U,5,99)

 +3        IF '$DATA(X)

               WRITE !!,"Visit information NOT correct for this patient.",!,$CHAR(7),$CHAR(7)

               HANG 3

               QUIT

 +4        KILL APCDALVR

 +5        DO ^APCDALV

 +6        IF $DATA(APCDALVR("APCDAFLG"))

               WRITE !!,$CHAR(7),$CHAR(7),"Visit creation failed!!",!

               QUIT

 +7        IF '$GET(APCDVSIT)

               WRITE !!,"No visit selected!!"

               QUIT

 +8       ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")>$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR

 +9       ;above added for EHR and auditing of visits, d/e created

 +10       KILL APCDALVR

 +11       DO PROVIDER

 +12       IF '$$PRIMPROV^APCLV(APCDVSIT,"I")

               WRITE !!,$CHAR(7),$CHAR(7),"Primary Provider Not Entered correctly.  Deleting incomplete visit.",!

               HANG 5

               DO DELETE

               QUIT

 +13       DO APCPOV

 +14       IF '$$PRIMPOV^APCLV(APCDVSIT,"I")

               WRITE !!,$CHAR(7),$CHAR(7),"Purpose of Visit Not Entered correctly.  Deleting incomplete visit.",!

               HANG 5

               DO DELETE

               QUIT

 +15       DO MNEPROC

 +16       QUIT

MNEPROC   ; PROCESS MNEMONICS UNTIL DONE

 +1        WRITE !!,"You may now enter any other information using the PCC mnemonics.",!

 +2        SET APCDMPQ=0

 +3        FOR

               DO GETMNE

               IF $DATA(APCDEQX)

                   DO CHKEHR2^APCDVCHK

               IF APCDMPQ

                   QUIT

 +4        DO GETMNEK

 +5        KILL APCDMPQ

 +6        QUIT

 +7       ;

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^APCDEGP0

               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 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,APCDEGX,APCDEQX

 +2        QUIT

APCPOV    ;get APC RECODES AND FILE

 +1        KILL APCDALVR

 +2        SET DIC="^AUTTRCD("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter APC CODE...............: "

           DO ^DIC

           KILL DIC,DA

 +3        IF Y=-1&((X="")!(X="^"))&('$$PRIMPOV^APCLV(APCDVSIT,"I"))

               GOTO ICDPOV

 +4        IF Y=-1

               QUIT

 +5        SET APCDAPCC=$PIECE(Y,U,2)

           SET APCDAPC=+Y

           IF APCDAPCC>699&(APCDAPCC<800)

               DO INJ

 +6        SET APCDICD=$PIECE(^AUTTRCD(APCDAPC,0),U,6)

           IF APCDICD=""

               WRITE !!,$CHAR(7),$CHAR(7),"NO ICD CODE ASSOCIATED WITH APC CODE ",APCDAPCC

               HANG 3

               QUIT

 +7        SET APCDALVR("APCDTPOV")=APCDICD

 +8        SET APCDALVR("APCDVSIT")=APCDVSIT

           SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"

           SET APCDALVR("APCDPAT")=APCDPAT

 +9        SET APCDALVR("APCDTNQ")=$PIECE(^AUTTRCD(APCDAPC,0),U,3)

 +10       DO ^APCDALVR

 +11       IF $DATA(APCDALVR("APCDAFLG"))

               WRITE !!,$CHAR(7),$CHAR(7),"Creating V Provider failed..."

 +12       GOTO APCPOV

 +13       QUIT

ICDPOV    ;

 +1        KILL APCDALVR

 +2        SET DIC="^APCDTKW("

           SET DIC(0)="E"

           SET X="IPV"

           DO ^DIC

           KILL DIC,DA

 +3        IF Y=-1

               WRITE !!,$CHAR(7),$CHAR(7),"Can't find IPV mnemonic!!",!

               HANG 4

               QUIT

 +4        SET APCDMNE=+Y

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

 +5        DO ^APCDEA3

 +6        QUIT

PROVIDER  ;

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

               XECUTE ^DD(9000010.06,.01,12.1)

 +2        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('$$PRIMPROV^APCLV(APCDVSIT,"I"):"Enter PRIMARY Provider.......: ",1:"Enter OTHER Provider.........: ")

           DO ^DIC

           KILL DIC

 +3        IF Y=-1

               QUIT

PROV11    ;

 +1        SET APCDALVR("APCDTPRO")="`"_+Y

 +2        SET APCDALVR("APCDVSIT")=APCDVSIT

           SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"

           SET APCDALVR("APCDPAT")=APCDPAT

 +3        SET APCDALVR("APCDTPS")=$SELECT($$PRIMPROV^APCLV(APCDVSIT,"I"):"S",1:"P")

 +4        DO ^APCDALVR

 +5        IF $DATA(APCDALVR("APCDAFLG"))

               WRITE !!,$CHAR(7),$CHAR(7),"Creating V Provider failed..."

 +6        GOTO PROVIDER

 +7        QUIT

INJ       ;

CAUSE     ;

 +1        SET DIC="^AUTTRIJ("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter EXTERNAL CAUSE OF INJURY: "

           DO ^DIC

           KILL DA,DIC

 +2        IF Y=-1

               WRITE !,"NO External Cause entered.",!

               GOTO PLACE

 +3        SET APCDALVR("APCDTCI")=$PIECE(^AUTTRIJ(+Y,0),U,3)

 +4        SET APCDALVR("APCDTFR")="F"

PLACE     ;

 +1        SET DIR(0)="9000010.07,.11"

           SET DIR("A")="Enter PLACE OF INJURY"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO CAUSEDX

 +3        IF Y=""

               GOTO CAUSEDX

 +4        SET APCDALVR("APCDTPA")=Y

CAUSEDX   ;

 +1        SET DIR(0)="9000010.07,.07"

           SET DIR("A")="Enter CAUSE OF DX (if alcohol related)"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        WRITE !

 +3        IF $DATA(DIRUT)

               QUIT

 +4        IF Y=""

               QUIT

 +5        SET APCDALVR("APCDTCD")=Y

 +6        QUIT

DELETE    ;

 +1        SET APCDVDLT=APCDVSIT

           DO ^APCDVDLT

 +2        WRITE !!,"Deleted.",!

 +3        QUIT

EOJ       ; END OF JOB

 +1        DO KILL^AUPNPAT

 +2        KILL APCDVSIT,APCDAPC,APCDAPCC,APCDHDAT,APCDDATE,APCDLOC,APCDTYPE,APCDCAT,APCDMNE,APCDALVR,APCDICD,APCDRV,APCDTCB,APCDTCM,APCDTORH

 +3        DO ^APCDEKL

 +4        QUIT

TEXT      ;

 +1       ;;PCC Data Entry Module

 +2       ;;

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

 +4       ;;* APC FORM ENTRY Mode *

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

 +6       ;;

APCDEAPC.m