- 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
