APCDELM ; IHS/CMI/LAB - prcess visit in list man ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
;This routine in the driver routine for data entry option
;ENTER DATA W/ITEM LIST. It prompts for enough information
;to create or select a visit and then uses list manager to
;present the data entry items to the user for selection.
;
EN ;EP - called from option
HDR ; Write Header
D ^APCDEKL ;clean up before starting
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,APCDEXIT
W !!
D ^APCDEIN ;set up data entry site parameters
Q:APCDFLG
S APCDTPLT("NAME")="MNEMONIC",APCDTPLT=0 ;these are needed for data entry routines
D PROCESS
D EOJ
Q
;
;
;
PROCESS ;process each visit
GETLOC ; GET LOCATION OF ENCOUNTER
S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)
S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDLOC=+Y
;
GETTYPE ; GET TYPE OF ENCOUNTER
S APCDTYPE=""
K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
I $D(APCDDEFT),APCDDEFT]"" S DIR("B")=APCDDEFT
S DIR(0)="9000010,.03",DIR("A")="TYPE" D ^DIR K DIR
G:$D(DIRUT) GETLOC
S APCDTYPE=X
;
GETCAT ; GET SERVICE CATEGORY
S APCDCAT=""
K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
I $D(APCDDEFS),APCDDEFS]"" S DIR("B")=APCDDEFS
S DIR(0)="9000010,.07",DIR("A")="SERVICE CATEGORY" D ^DIR K DIR
G:$D(DIRUT) GETTYPE
S APCDCAT=X
;
GETDATE ; GET DATE OF ENCOUNTER
S APCDDATE=""
W !!,"VISIT DATE: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X=""
G:X=""!(X="^") GETCAT
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=Y
GETPAT ; GET PATIENT
D GETPAT^APCDEA
Q:APCDPAT=""
;
;W !
;S APCDPAT=""
;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
;I DUZ("AG")="I" D ^APCDEMDI I $D(^APCDSITE(DUZ(2),11)) D ^APCDECC
GETVISIT ;
S APCDNOXV="" D ^APCDALV K APCDNOXV
I $D(APCDAFLG)#2,APCDAFLG=2 W $C(7),!,"VISIT date not valid for current patient!",! S APCDFLG=1 Q
I APCDVSIT="" W !!,"No visit selected." Q
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
CLN ;
G:$P(^AUPNVSIT(APCDVSIT,0),U,8) LM
W !!,"Please enter the clinic this patient is attending.",!
S APCDCLN=""
S DIC="^DIC(40.7,",DIC(0)="AEMQ" D ^DIC K DIC
I X="" W !,"Clinic is Required." K APCDDATE,APCDVSIT G GETDATE
I Y<0 G CLN
S APCDCLN=+Y
S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".08///`"_APCDCLN D ^DIE K DIE,DA,DR
LM ;EP
D EN^APCDEL
I $G(APCDVSIT) D EP^APCDKDE
I $G(APCDVSIT) D ^APCDVCHK
Q
;
;
EOJ ; END OF JOB
D KILL^AUPNPAT
K APCDHIGH,APCDSEL,APCDCUT,APCDDISP,APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT
K ^TMP("APCDEL",$J)
D ^APCDEKL
D ^XBFMK
Q
TEXT ;
;;PCC Data Entry Module
;;
;;************************************************
;;***** PCC DATA ENTRY UPDATE VISIT BY ITEM *****
;;************************************************
;;
Q
APCDELM ; IHS/CMI/LAB - prcess visit in list man ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
+4 ;This routine in the driver routine for data entry option
+5 ;ENTER DATA W/ITEM LIST. It prompts for enough information
+6 ;to create or select a visit and then uses list manager to
+7 ;present the data entry items to the user for selection.
+8 ;
EN ;EP - called from option
HDR ; Write Header
+1 ;clean up before starting
DO ^APCDEKL
+2 IF $DATA(IOF)
WRITE @IOF
+3 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 ;set up data entry site parameters
DO ^APCDEIN
+7 IF APCDFLG
QUIT
+8 ;these are needed for data entry routines
SET APCDTPLT("NAME")="MNEMONIC"
SET APCDTPLT=0
+9 DO PROCESS
+10 DO EOJ
+11 QUIT
+12 ;
+13 ;
+14 ;
PROCESS ;process each visit
GETLOC ; GET LOCATION OF ENCOUNTER
+1 SET APCDLOC=""
IF $DATA(APCDDEFL)
IF APCDDEFL]""
SET DIC("B")=$PIECE(^DIC(4,APCDDEFL,0),U)
+2 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+3 IF Y<0
QUIT
+4 SET APCDLOC=+Y
+5 ;
GETTYPE ; GET TYPE OF ENCOUNTER
+1 SET APCDTYPE=""
+2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
+3 IF $DATA(APCDDEFT)
IF APCDDEFT]""
SET DIR("B")=APCDDEFT
+4 SET DIR(0)="9000010,.03"
SET DIR("A")="TYPE"
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO GETLOC
+6 SET APCDTYPE=X
+7 ;
GETCAT ; GET SERVICE CATEGORY
+1 SET APCDCAT=""
+2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
+3 IF $DATA(APCDDEFS)
IF APCDDEFS]""
SET DIR("B")=APCDDEFS
+4 SET DIR(0)="9000010,.07"
SET DIR("A")="SERVICE CATEGORY"
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO GETTYPE
+6 SET APCDCAT=X
+7 ;
GETDATE ; GET DATE OF ENCOUNTER
+1 SET APCDDATE=""
+2 WRITE !!,"VISIT DATE: "
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET X=""
+3 IF X=""!(X="^")
GOTO GETCAT
+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=Y
GETPAT ; GET PATIENT
+1 DO GETPAT^APCDEA
+2 IF APCDPAT=""
QUIT
+3 ;
+4 ;W !
+5 ;S APCDPAT=""
+6 ;S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
+7 ;Q:Y<0
+8 ;I $D(APCDPARM),$P(APCDPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1
+9 ;S APCDPAT=+Y
+10 ;I DUZ("AG")="I" D ^APCDEMDI I $D(^APCDSITE(DUZ(2),11)) D ^APCDECC
GETVISIT ;
+1 SET APCDNOXV=""
DO ^APCDALV
KILL APCDNOXV
+2 IF $DATA(APCDAFLG)#2
IF APCDAFLG=2
WRITE $CHAR(7),!,"VISIT date not valid for current patient!",!
SET APCDFLG=1
QUIT
+3 IF APCDVSIT=""
WRITE !!,"No visit selected."
QUIT
+4 SET APCDLVST=APCDVSIT
+5 SET DIE="^AUPNPAT("
SET DR=".16///TODAY"
SET DA=APCDPAT
DO ^DIE
+6 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+7 IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
CLN ;
+1 IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,8)
GOTO LM
+2 WRITE !!,"Please enter the clinic this patient is attending.",!
+3 SET APCDCLN=""
+4 SET DIC="^DIC(40.7,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+5 IF X=""
WRITE !,"Clinic is Required."
KILL APCDDATE,APCDVSIT
GOTO GETDATE
+6 IF Y<0
GOTO CLN
+7 SET APCDCLN=+Y
+8 SET DIE="^AUPNVSIT("
SET DA=APCDVSIT
SET DR=".08///`"_APCDCLN
DO ^DIE
KILL DIE,DA,DR
LM ;EP
+1 DO EN^APCDEL
+2 IF $GET(APCDVSIT)
DO EP^APCDKDE
+3 IF $GET(APCDVSIT)
DO ^APCDVCHK
+4 QUIT
+5 ;
+6 ;
EOJ ; END OF JOB
+1 DO KILL^AUPNPAT
+2 KILL APCDHIGH,APCDSEL,APCDCUT,APCDDISP,APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT
+3 KILL ^TMP("APCDEL",$JOB)
+4 DO ^APCDEKL
+5 DO ^XBFMK
+6 QUIT
TEXT ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;************************************************
+4 ;;***** PCC DATA ENTRY UPDATE VISIT BY ITEM *****
+5 ;;************************************************
+6 ;;
+7 QUIT
