APCDEATC.m

APCDEATC ; IHS/CMI/LAB - ENTER TRANS CODE TO OUTPATIENT VISIT ;

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

 ;

 ;  Enter Trans Codes on existing Outpatient visit

 ;

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

 Q:APCDFLG

 I '$D(APCDPARM) D ^APCDVAR

 S APCDPAT="",APCDNOXV=""

 F  D GETPAT Q:APCDPAT=""  D GETVISIT I APCDVSIT D MNEPROC

 D EOJ

 Q

 ;

GETPAT ; GET PATIENT

 W !

 S APCDPAT=""

 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^APCDEA(APCDPAT,.X) I 'X S APCDPAT="" Q

 I DUZ("AG")="I" D ^APCDEMDI

 Q

 ;

GETVISIT ; GET VISIT

 S (APCDDATE,APCDVSIT)=""

RDV W !,"Enter VISIT date: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X="" I X=" " W $C(7),"  ??" G RDV

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

 S %DT="EXP" D ^%DT

 G:X="?" RDV

 I Y<0 K Y Q

 S APCDDATE=Y

 D FINDVSIT

 I APCDVSIT S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT S APCDCAT=$P(^AUPNVSIT(APCDVSIT,0),U,7),APCDLOC=$P(^(0),U,6),APCDTYPE=$P(^(0),U,3),APCDPAT=$P(^(0),U,5),APCDDATE=$P($P(^(0),U),"."),APCDCLN=$P(^(0),U,8)

 I APCDVSIT,AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob

 Q

 ;

MNEPROC ; PROCESS MNEMONICS UNTIL DONE

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

 W !

 S X="TC",DIC="^APCDTKW(",DIC(0)="M" D ^DIC K DIC

 I Y<0 W !!,"Error Occurred.  Could not find TC mnemonic!" Q

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

 D ^APCDEA3

 S APCDMPQ=0

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

 I $$DTC^APCDKDTC(APCDVSIT) D START^APCDKDTC(APCDVSIT)

 I $P(APCDPARM,U,5)="Y" S APCDFV=APCDVSIT D ^APCDFCTC K APCDFV

 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=-1 S APCDMPQ=1 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

 Q

 ;

 ;

GETMNEK ; KILL GETMNE SPECIFIC VARIABLES

 K APCDVSIT,APCDX,APCDEQX

 Q

 ;

 ;

GENVISIT ; GENERATE NEW VISIT

 S Y=APCDPAT D ^AUPNPAT K Y

 S APCDSEX=AUPNSEX,APCDDOB=AUPNDOB,APCDDOD=AUPNDOD

 S APCDDATE=$P(APCDDATE,".")_".12"

 S X=APCDDATE,%DT="TRXN" D ^%DT S X=Y I X=-1 S APCDAFLG=2,APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q

 D VSIT01^AUPNVSIT

 I '$D(X) S APCDAFLG=2,APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q

 S APCDLOC=DUZ(2)

 S APCDCAT="I"

 ;get type of visit

 D GETTYPE

 I APCDTYPE="" W !,"Visit NOT Created!" Q

 K APCDLOOK S X=APCDDATE,DIC="^AUPNVSIT(",DIC(0)="L"_$S($D(ZTQUEUED)!($D(ZTSK)):"",1:"E"),DLAYGO=9000010,DIC("DR")="[APCD VISIT (ADD)]" K DD,DO D FILE^DICN K DIC,DLAYGO

 I Y<0 S APCDAFLG=2,APCDAFLG("ERR")=".01^"_APCDDATE_"^FILE^DICN FAILED TO CREATE VISIT" Q

 S APCDVSIT=+Y

 S APCDVSIT("NEW")=1

 Q

 ;

 ;--------------------------------------------------------------

 ;

GETTYPE ; GET TYPE OF ENCOUNTER

 S APCDTYPE=""

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

 S DIR("B")=$P($G(^APCDSITE(DUZ(2),0)),U,11)

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

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

 S APCDTYPE=Y

 Q

 ;

EOJ ; END OF JOB

 D ^APCDEKL,EN^XBVK("APCD")

 K DX,S,A,POP,IOY,%,%DT,X,Y,DI,DIGG,DIPGM,DISYS,DI,%1,DQ

 D ^XBFMK

 D KILL^AUPNPAT

 Q

FINDVSIT ; INTERACTIVE MODE

 K APCDALV

 S (APCDAVD,APCDAVDC)=9999999-$P(APCDDATE,"."),APCDAVD=(APCDAVD-1)_".999999"

 S APCDAC=2

 F APCDAL=0:0 S APCDAVD=$O(^AUPNVSIT("AA",APCDPAT,APCDAVD)) Q:APCDAVD=""  Q:$P(APCDAVD,".")'=APCDAVDC  F APCDAI=0:0 S APCDAI=$O(^AUPNVSIT("AA",APCDPAT,APCDAVD,APCDAI)) Q:APCDAI=""  D GATHER

 I '$D(APCDALV) W !!,"No OUTPATIENT Visits for ",$P(^DPT(APCDPAT,0),U),"on ",$$FMTE^XLFDT(APCDDATE),".",! Q

 D SELECT

 I APCDAO=4,'$D(APCDALV(4)) G FINDVSIT

 Q

 ;

GATHER ; GATHER VISITS FOR USER TO SELECT

 S APCDAX=^AUPNVSIT(APCDAI,0)

 Q:$P(APCDAX,U,11)

 ;Q:$P(APCDAX,U,6)'=DUZ(2)  ;only visits to this location

 Q:"AOS"'[$P(APCDAX,U,7)  ;only outpatient

 S APCDAC=APCDAC+1,APCDALV(APCDAC)=APCDAI

 Q

 ;

SELECT ; ALLOW USER TO SELECT, EXIT, OR ADD

 I '$D(APCDADF),APCDAC=3 S APCDADF=APCDAC

 S APCDAO=""

 D OPTION ;                         get option from user

 I APCDAO=1 S APCDAFLG=1 Q  ;       exit with no selection

 S Y=$P(^AUPNVSIT(APCDVSIT,0),U,5) D ^AUPNPAT K Y

 Q

 ;

OPTION ;EP;GET OPTION FROM USER

 F APCDAL=0:0 D OPTION2 Q:APCDAO

 Q

 ;

OPTION2 ; LET USER SELECT OPTION

 W !!,"PATIENT: ",$P(^DPT(APCDPAT,0),U)," has VISITs, same date, location.",!

 W !,"1  Exit without selecting VISIT"

 W !,"2  Display one of the existing VISITs"

 W !!,"Or select one of the following existing VISITs:",!

 F APCDAI=0:0 S APCDAI=$O(APCDALV(APCDAI)) Q:APCDAI=""  S APCDAX=APCDALV(APCDAI) D WRITE

 S DIR(0)="N^1:"_APCDAC_":0",DIR("A")="Choose one",DIR("?")="Choose one of the numbers listed above" S:$D(APCDADF) DIR("B")=APCDADF D ^DIR K DIR

 I $D(DIRUT) S APCDAO=1 Q

 S Y=+Y

 I Y=2 D DISPLAY Q

 I Y<3 S APCDAO=Y Q

 S APCDAO=Y,APCDVSIT=APCDALV(Y)

 Q

 ;

WRITE ; WRITE VISITS FOR SELECT

 S APCDAX=^AUPNVSIT(APCDAX,0)

 S APCDAT=$P(+APCDAX,".",2),APCDAT=$S(APCDAT="":"<NONE>",$L(APCDAT)=1:APCDAT_"0:00 ",1:$E(APCDAT,1,2)_":"_$E(APCDAT,3,4)_$E("00",1,2-$L($E(APCDAT,3,4)))_" ")

 W !,APCDAI,"  TIME: ",APCDAT,"  TYPE: ",$P(APCDAX,U,3),"  CATEGORY: ",$P(APCDAX,U,7),"  CLINIC: ",$S($P(APCDAX,U,8)]"":$E($P(^DIC(40.7,$P(APCDAX,U,8),0),U),1,13),1:"<NONE>"),?72,"DEC: ",$S($P(APCDAX,U,9):$P(APCDAX,U,9),1:0)

 K APCDAT

 Q

 ;

DISPLAY ; DISPLAY VISIT FOR USER

 I APCDAC=3 S APCDVSIT=APCDALV(APCDAC) D EN1^APCDVD S APCDVSIT="" Q

 S DIR(0)="NO^"_3_":"_APCDAC_":0",DIR("A")="Which one",DIR("?")="Enter the number associated with the visit you wish to display" D ^DIR K DIR

 Q:$D(DIRUT)

 S APCDVSIT=APCDALV(+Y) D EN1^APCDVD S APCDVSIT=""

 Q

 ;

TEXT ;

 ;;PCC Data Entry Module

 ;;

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

 ;;* ENTER TRANS CODES FOR OUTPATIENT VISITS *

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

 Q

APCDEATC  ; IHS/CMI/LAB - ENTER TRANS CODE TO OUTPATIENT VISIT ;

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

 +2       ;

 +3       ;  Enter Trans Codes on existing Outpatient visit

 +4       ;

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

 +6        IF APCDFLG

               QUIT 

 +7        IF '$DATA(APCDPARM)

               DO ^APCDVAR

 +8        SET APCDPAT=""

           SET APCDNOXV=""

 +9        FOR 

               DO GETPAT

               IF APCDPAT=""

                   QUIT 

               DO GETVISIT

               IF APCDVSIT

                   DO MNEPROC

 +10       DO EOJ

 +11       QUIT 

 +12      ;

GETPAT    ; GET PATIENT

 +1        WRITE !

 +2        SET APCDPAT=""

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

               SET AUPNLK("INAC")=1

 +4        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        DO INAC^APCDEA(APCDPAT,.X)

           IF 'X

               SET APCDPAT=""

               QUIT 

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

               DO ^APCDEMDI

 +10       QUIT 

 +11      ;

GETVISIT  ; GET VISIT

 +1        SET (APCDDATE,APCDVSIT)=""

RDV        WRITE !,"Enter VISIT date: "

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

           IF '$TEST

               SET X=""

           IF X=" "

               WRITE $CHAR(7),"  ??"

               GOTO RDV

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

               QUIT 

 +2        SET %DT="EXP"

           DO ^%DT

 +3        IF X="?"

               GOTO RDV

 +4        IF Y<0

               KILL Y

               QUIT 

 +5        SET APCDDATE=Y

 +6        DO FINDVSIT

 +7        IF APCDVSIT

               SET AUPNVSIT=APCDVSIT

               DO MOD^AUPNVSIT

               SET APCDCAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)

               SET APCDLOC=$PIECE(^(0),U,6)

               SET APCDTYPE=$PIECE(^(0),U,3)

               SET APCDPAT=$PIECE(^(0),U,5)

               SET APCDDATE=$PIECE($PIECE(^(0),U),".")

               SET APCDCLN=$PIECE(^(0),U,8)

 +8       ; re-set days of age to visit date-dob

           IF APCDVSIT

               IF AUPNDOB]""

                   SET X2=AUPNDOB

                   SET X1=APCDDATE

                   DO ^%DTC

                   SET AUPNDAYS=X

 +9        QUIT 

 +10      ;

MNEPROC   ; PROCESS MNEMONICS UNTIL DONE

 +1        SET DIE="^AUPNPAT("

           SET DR=".16///TODAY"

           SET DA=APCDPAT

           DO ^DIE

 +2        WRITE !

 +3        SET X="TC"

           SET DIC="^APCDTKW("

           SET DIC(0)="M"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               WRITE !!,"Error Occurred.  Could not find TC mnemonic!"

               QUIT 

 +5        SET APCDMNE=+Y

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

 +6        DO ^APCDEA3

 +7        SET APCDMPQ=0

 +8        FOR 

               DO GETMNE

               IF $DATA(APCDEQX)

                   DO CHKEHR2^APCDVCHK

               IF APCDMPQ

                   QUIT 

 +9        IF $$DTC^APCDKDTC(APCDVSIT)

               DO START^APCDKDTC(APCDVSIT)

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

               SET APCDFV=APCDVSIT

               DO ^APCDFCTC

               KILL APCDFV

 +11       DO GETMNEK

 +12       KILL APCDMPQ,APCDREGU

 +13       WRITE !

 +14       QUIT 

 +15      ;

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=-1

               SET APCDMPQ=1

               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      ;

 +11      ;

GETMNEK   ; KILL GETMNE SPECIFIC VARIABLES

 +1        KILL APCDVSIT,APCDX,APCDEQX

 +2        QUIT 

 +3       ;

 +4       ;

GENVISIT  ; GENERATE NEW VISIT

 +1        SET Y=APCDPAT

           DO ^AUPNPAT

           KILL Y

 +2        SET APCDSEX=AUPNSEX

           SET APCDDOB=AUPNDOB

           SET APCDDOD=AUPNDOD

 +3        SET APCDDATE=$PIECE(APCDDATE,".")_".12"

 +4        SET X=APCDDATE

           SET %DT="TRXN"

           DO ^%DT

           SET X=Y

           IF X=-1

               SET APCDAFLG=2

               SET APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"

               QUIT 

 +5        DO VSIT01^AUPNVSIT

 +6        IF '$DATA(X)

               SET APCDAFLG=2

               SET APCDAFLG("ERR")=".01^"_APCDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"

               QUIT 

 +7        SET APCDLOC=DUZ(2)

 +8        SET APCDCAT="I"

 +9       ;get type of visit

 +10       DO GETTYPE

 +11       IF APCDTYPE=""

               WRITE !,"Visit NOT Created!"

               QUIT 

 +12       KILL APCDLOOK

           SET X=APCDDATE

           SET DIC="^AUPNVSIT("

           SET DIC(0)="L"_$SELECT($DATA(ZTQUEUED)!($DATA(ZTSK)):"",1:"E")

           SET DLAYGO=9000010

           SET DIC("DR")="[APCD VISIT (ADD)]"

           KILL DD,DO

           DO FILE^DICN

           KILL DIC,DLAYGO

 +13       IF Y<0

               SET APCDAFLG=2

               SET APCDAFLG("ERR")=".01^"_APCDDATE_"^FILE^DICN FAILED TO CREATE VISIT"

               QUIT 

 +14       SET APCDVSIT=+Y

 +15       SET APCDVSIT("NEW")=1

 +16       QUIT 

 +17      ;

 +18      ;--------------------------------------------------------------

 +19      ;

GETTYPE   ; GET TYPE OF ENCOUNTER

 +1        SET APCDTYPE=""

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

 +3        SET DIR("B")=$PIECE($GET(^APCDSITE(DUZ(2),0)),U,11)

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

           SET DIR("A")="TYPE OF VISIT"

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               SET X=""

               QUIT 

 +6        SET APCDTYPE=Y

 +7        QUIT 

 +8       ;

EOJ       ; END OF JOB

 +1        DO ^APCDEKL

           DO EN^XBVK("APCD")

 +2        KILL DX,S,A,POP,IOY,%,%DT,X,Y,DI,DIGG,DIPGM,DISYS,DI,%1,DQ

 +3        DO ^XBFMK

 +4        DO KILL^AUPNPAT

 +5        QUIT 

FINDVSIT  ; INTERACTIVE MODE

 +1        KILL APCDALV

 +2        SET (APCDAVD,APCDAVDC)=9999999-$PIECE(APCDDATE,".")

           SET APCDAVD=(APCDAVD-1)_".999999"

 +3        SET APCDAC=2

 +4        FOR APCDAL=0:0

               SET APCDAVD=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDAVD))

               IF APCDAVD=""

                   QUIT 

               IF $PIECE(APCDAVD,".")'=APCDAVDC

                   QUIT 

               FOR APCDAI=0:0

                   SET APCDAI=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDAVD,APCDAI))

                   IF APCDAI=""

                       QUIT 

                   DO GATHER

 +5        IF '$DATA(APCDALV)

               WRITE !!,"No OUTPATIENT Visits for ",$PIECE(^DPT(APCDPAT,0),U),"on ",$$FMTE^XLFDT(APCDDATE),".",!

               QUIT 

 +6        DO SELECT

 +7        IF APCDAO=4

               IF '$DATA(APCDALV(4))

                   GOTO FINDVSIT

 +8        QUIT 

 +9       ;

GATHER    ; GATHER VISITS FOR USER TO SELECT

 +1        SET APCDAX=^AUPNVSIT(APCDAI,0)

 +2        IF $PIECE(APCDAX,U,11)

               QUIT 

 +3       ;Q:$P(APCDAX,U,6)'=DUZ(2)  ;only visits to this location

 +4       ;only outpatient

           IF "AOS"'[$PIECE(APCDAX,U,7)

               QUIT 

 +5        SET APCDAC=APCDAC+1

           SET APCDALV(APCDAC)=APCDAI

 +6        QUIT 

 +7       ;

SELECT    ; ALLOW USER TO SELECT, EXIT, OR ADD

 +1        IF '$DATA(APCDADF)

               IF APCDAC=3

                   SET APCDADF=APCDAC

 +2        SET APCDAO=""

 +3       ;                         get option from user

           DO OPTION

 +4       ;       exit with no selection

           IF APCDAO=1

               SET APCDAFLG=1

               QUIT 

 +5        SET Y=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)

           DO ^AUPNPAT

           KILL Y

 +6        QUIT 

 +7       ;

OPTION    ;EP;GET OPTION FROM USER

 +1        FOR APCDAL=0:0

               DO OPTION2

               IF APCDAO

                   QUIT 

 +2        QUIT 

 +3       ;

OPTION2   ; LET USER SELECT OPTION

 +1        WRITE !!,"PATIENT: ",$PIECE(^DPT(APCDPAT,0),U)," has VISITs, same date, location.",!

 +2        WRITE !,"1  Exit without selecting VISIT"

 +3        WRITE !,"2  Display one of the existing VISITs"

 +4        WRITE !!,"Or select one of the following existing VISITs:",!

 +5        FOR APCDAI=0:0

               SET APCDAI=$ORDER(APCDALV(APCDAI))

               IF APCDAI=""

                   QUIT 

               SET APCDAX=APCDALV(APCDAI)

               DO WRITE

 +6        SET DIR(0)="N^1:"_APCDAC_":0"

           SET DIR("A")="Choose one"

           SET DIR("?")="Choose one of the numbers listed above"

           IF $DATA(APCDADF)

               SET DIR("B")=APCDADF

           DO ^DIR

           KILL DIR

 +7        IF $DATA(DIRUT)

               SET APCDAO=1

               QUIT 

 +8        SET Y=+Y

 +9        IF Y=2

               DO DISPLAY

               QUIT 

 +10       IF Y<3

               SET APCDAO=Y

               QUIT 

 +11       SET APCDAO=Y

           SET APCDVSIT=APCDALV(Y)

 +12       QUIT 

 +13      ;

WRITE     ; WRITE VISITS FOR SELECT

 +1        SET APCDAX=^AUPNVSIT(APCDAX,0)

 +2        SET APCDAT=$PIECE(+APCDAX,".",2)

           SET APCDAT=$SELECT(APCDAT="":"<NONE>",$LENGTH(APCDAT)=1:APCDAT_"0:00 ",1:$EXTRACT(APCDAT,1,2)_":"_$EXTRACT(APCDAT,3,4)_$EXTRACT("00",1,2-$LENGTH($EXTRACT(APCDAT,3,4)))_" ")

 +3       WRITE !,APCDAI,"  TIME: ",APCDAT,"  TYPE: ",$PIECE(APCDAX,U,3),"  CATEGORY: ",$PIECE(APCDAX,U,7),"  CLINIC: ",$SELECT($PIECE(APCDAX,U,8)]"":$EXTRACT($PIECE(^DIC(40.7,...

           ... $PIECE(APCDAX,U,8),0),U),1,13),1:"<NONE>"),?72,"DEC: ",$SELECT($PIECE(APCDAX,U,9):$PIECE(APCDAX,U,9),1:0)

 +4        KILL APCDAT

 +5        QUIT 

 +6       ;

DISPLAY   ; DISPLAY VISIT FOR USER

 +1        IF APCDAC=3

               SET APCDVSIT=APCDALV(APCDAC)

               DO EN1^APCDVD

               SET APCDVSIT=""

               QUIT 

 +2        SET DIR(0)="NO^"_3_":"_APCDAC_":0"

           SET DIR("A")="Which one"

           SET DIR("?")="Enter the number associated with the visit you wish to display"

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET APCDVSIT=APCDALV(+Y)

           DO EN1^APCDVD

           SET APCDVSIT=""

 +5        QUIT 

 +6       ;

TEXT      ;

 +1       ;;PCC Data Entry Module

 +2       ;;

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

 +4       ;;* ENTER TRANS CODES FOR OUTPATIENT VISITS *

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

 +6        QUIT