APCDEDTC ; IHS/CMI/LAB - ENTER DTC FOR I/A ;
;;2.0;IHS PCC SUITE;**2,17**;MAY 14, 2009;Build 18
;
; Enter Trans Codes on existing In Hospital visit
; Mnemonics allowed: TC, DISP, MOD
;
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="" S APCDCAT="" F D GETCAT Q:APCDCAT="" D GETVISIT I APCDVSIT D MNEPROC
D EOJ
Q
;
GETCAT ;
S APCDCAT=""
K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
S DIR(0)="9000010,.07O",DIR("A")="SERVICE CATEGORY" D ^DIR K DIR
I $D(DIRUT) S Y="" Q
S APCDCAT=Y
I "AORSI"'[APCDCAT W $C(7),$C(7),!!,"That SERIVCE CATEGORY is not appropriate for this option!" G GETCAT
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
W !
S X="DTC",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
;check for billing link for tc's entered with DTC
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)
;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=3
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 "_$$EXTSET^XBFUNC(9000010,.07,APCDCAT)_" Visits for ",$P(^DPT(APCDPAT,0),U),!,"on ",$$FMTE^XLFDT(APCDDATE)," at ",$P(^DIC(4,DUZ(2),0),U),".",! D Q
.;se if user wants to create a new visit
.W ! S DIR(0)="Y",DIR("A")="Do you wish to create a new "_$S(APCDCAT="A":"AMBULATORY",APCDCAT="I":"IN-HOSPITAL",1:"A")_" Visit for this patient",DIR("B")="Y" KILL DA D ^DIR KILL DIR
.Q:$D(DIRUT)
.Q:'Y
.D GENVISIT
D SELECT ; select or generate visit
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:$P(APCDAX,U,7)'=APCDCAT
S APCDAC=APCDAC+1,APCDALV(APCDAC)=APCDAI
Q
;
SELECT ; ALLOW USER TO SELECT, EXIT, OR ADD
I '$D(APCDADF),APCDAC=4 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 !,"3 Create new Visit",!
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 D GENVISIT S APCDAO=3 Q
I Y<4 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 (DTC) FOR HOSPITALIZATION/AMBULATORY VISITS *
;;************************************************
Q
APCDEDTC ; IHS/CMI/LAB - ENTER DTC FOR I/A ;
+1 ;;2.0;IHS PCC SUITE;**2,17**;MAY 14, 2009;Build 18
+2 ;
+3 ; Enter Trans Codes on existing In Hospital visit
+4 ; Mnemonics allowed: TC, DISP, MOD
+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
+6 IF APCDFLG
QUIT
+7 IF '$DATA(APCDPARM)
DO ^APCDVAR
+8 SET APCDPAT=""
SET APCDNOXV=""
+9 FOR
DO GETPAT
IF APCDPAT=""
QUIT
SET APCDCAT=""
FOR
DO GETCAT
IF APCDCAT=""
QUIT
DO GETVISIT
IF APCDVSIT
DO MNEPROC
+10 DO EOJ
+11 QUIT
+12 ;
GETCAT ;
+1 SET APCDCAT=""
+2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
+3 SET DIR(0)="9000010,.07O"
SET DIR("A")="SERVICE CATEGORY"
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET Y=""
QUIT
+5 SET APCDCAT=Y
+6 IF "AORSI"'[APCDCAT
WRITE $CHAR(7),$CHAR(7),!!,"That SERIVCE CATEGORY is not appropriate for this option!"
GOTO GETCAT
+7 QUIT
+8 ;
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 WRITE !
+2 SET X="DTC"
SET DIC="^APCDTKW("
SET DIC(0)="M"
DO ^DIC
KILL DIC
+3 IF Y<0
WRITE !!,"Error Occurred. Could not find TC mnemonic!"
QUIT
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 DO ^APCDEA3
+6 SET APCDMPQ=0
+7 FOR
DO GETMNE
IF $DATA(APCDEQX)
DO CHKEHR2^APCDVCHK
IF APCDMPQ
QUIT
+8 ;check for billing link for tc's entered with DTC
+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 ;get type of visit
+9 DO GETTYPE
+10 IF APCDTYPE=""
WRITE !,"Visit NOT Created!"
QUIT
+11 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
+12 IF Y<0
SET APCDAFLG=2
SET APCDAFLG("ERR")=".01^"_APCDDATE_"^FILE^DICN FAILED TO CREATE VISIT"
QUIT
+13 SET APCDVSIT=+Y
+14 SET APCDVSIT("NEW")=1
+15 QUIT
+16 ;
+17 ;--------------------------------------------------------------
+18 ;
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=3
+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 "_$$EXTSET^XBFUNC(9000010,.07,APCDCAT)_" Visits for ",$PIECE(^DPT(APCDPAT,0),U),!,"on ",$$FMTE^XLFDT(APCDDATE)," at ",$PIECE(^DIC(4,DUZ(2),0),U),".",!
Begin DoDot:1
+6 ;se if user wants to create a new visit
+7 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you wish to create a new "_$SELECT(APCDCAT="A":"AMBULATORY",APCDCAT="I":"IN-HOSPITAL",1:"A")_" Visit for this patient"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
QUIT
+9 IF 'Y
QUIT
+10 DO GENVISIT
End DoDot:1
QUIT
+11 ; select or generate visit
DO SELECT
+12 IF APCDAO=4
IF '$DATA(APCDALV(4))
GOTO FINDVSIT
+13 QUIT
+14 ;
GATHER ; GATHER VISITS FOR USER TO SELECT
+1 SET APCDAX=^AUPNVSIT(APCDAI,0)
+2 IF $PIECE(APCDAX,U,11)
QUIT
+3 ;only visits to this location
IF $PIECE(APCDAX,U,6)'=DUZ(2)
QUIT
+4 IF $PIECE(APCDAX,U,7)'=APCDCAT
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=4
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 !,"3 Create new Visit",!
+5 WRITE !,"Or select one of the following existing VISITs:",!
+6 FOR APCDAI=0:0
SET APCDAI=$ORDER(APCDALV(APCDAI))
IF APCDAI=""
QUIT
SET APCDAX=APCDALV(APCDAI)
DO WRITE
+7 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
+8 IF $DATA(DIRUT)
SET APCDAO=1
QUIT
+9 SET Y=+Y
+10 IF Y=2
DO DISPLAY
QUIT
+11 IF Y=3
DO GENVISIT
SET APCDAO=3
QUIT
+12 IF Y<4
SET APCDAO=Y
QUIT
+13 SET APCDAO=Y
SET APCDVSIT=APCDALV(Y)
+14 QUIT
+15 ;
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 (DTC) FOR HOSPITALIZATION/AMBULATORY VISITS *
+5 ;;************************************************
+6 QUIT
