Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDELMP

APCDELMP.m

Go to the documentation of this file.
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