- APCDELMP ; IHS/CMI/LAB - prcess visit in list man ;
- ;;2.0;IHS PCC SUITE;;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 ;PEP - called from option - called from TIU
- HDR ; Write Header
- D EN1^APCDEKL ;clean up before starting
- D EN2^APCDEKL
- 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
- S APCDPAT=""
- F D GETPAT^APCDEAP Q:APCDPAT="" D GETVISIT^APCDEAP I APCDVSIT D LM^APCDELM K AUPNVSIT
- 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
- 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("A")="Enter CLINIC: ",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 ;
- D EN^APCDEFL
- I $G(APCDVSIT) D EP^APCDKDE
- Q
- ;
- ;
- EOJ ; END OF JOB
- D KILL^AUPNPAT
- K APCDHIGH,APCDSEL,APCDCUT,APCDDISP,APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT
- K ^TMP("APCDEF",$J)
- D ^APCDEKL,EN2^APCDEKL
- D ^XBFMK
- Q
- TEXT ;
- ;;PCC Data Entry Module
- ;;
- ;;************************************************
- ;;***** PCC DATA ENTRY UPDATE VISIT BY ITEM *****
- ;;************************************************
- ;;
- Q
- APCDELMP ; IHS/CMI/LAB - prcess visit in list man ;
- +1 ;;2.0;IHS PCC SUITE;;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 ;PEP - called from option - called from TIU
- HDR ; Write Header
- +1 ;clean up before starting
- DO EN1^APCDEKL
- +2 DO EN2^APCDEKL
- +3 IF $DATA(IOF)
- WRITE @IOF
- +4 FOR APCDJ=1:1:5
- SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)
- WRITE !?80-$LENGTH(APCDX)\2,APCDX
- +5 KILL APCDX,APCDJ,APCDEXIT
- +6 WRITE !!
- +7 ;set up data entry site parameters
- DO ^APCDEIN
- +8 IF APCDFLG
- QUIT
- +9 ;these are needed for data entry routines
- SET APCDTPLT("NAME")="MNEMONIC"
- SET APCDTPLT=0
- +10 SET APCDPAT=""
- +11 FOR
- DO GETPAT^APCDEAP
- IF APCDPAT=""
- QUIT
- DO GETVISIT^APCDEAP
- IF APCDVSIT
- DO LM^APCDELM
- KILL AUPNVSIT
- +12 DO EOJ
- +13 QUIT
- +14 ;
- +15 ;
- +16 ;
- 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 WRITE !
- +2 SET APCDPAT=""
- +3 SET DIC="^AUPNPAT("
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC
- +4 IF Y<0
- QUIT
- +5 IF $DATA(APCDPARM)
- IF $PIECE(APCDPARM,U,3)="Y"
- WRITE !?25,"Ok"
- SET %=1
- DO YN^DICN
- IF %'=1
- QUIT
- +6 SET APCDPAT=+Y
- +7 IF DUZ("AG")="I"
- DO ^APCDEMDI
- IF $DATA(^APCDSITE(DUZ(2),11))
- DO ^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("A")="Enter CLINIC: "
- 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 ;
- +1 DO EN^APCDEFL
- +2 IF $GET(APCDVSIT)
- DO EP^APCDKDE
- +3 QUIT
- +4 ;
- +5 ;
- EOJ ; END OF JOB
- +1 DO KILL^AUPNPAT
- +2 KILL APCDHIGH,APCDSEL,APCDCUT,APCDDISP,APCDANS,APCDC,APCDI,APCDCRIT,APCDTEXT
- +3 KILL ^TMP("APCDEF",$JOB)
- +4 DO ^APCDEKL
- DO EN2^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
