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

APCDPE1.m

Go to the documentation of this file.
  1. APCDPE1 ; IHS/CMI/LAB - DATA ENTRY ENTER MODE ;
  1. ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1. ;PATCH 2 commented out writing of date
  1. ;
  1. ; APCDFLG=0 ... RUN
  1. ; APCDFLG=1 ... ERROR
  1. ;
  1. ; APCDMODE=A ... ADD
  1. ; APCDMODE=M ... MOD
  1. ;
  1. HDR ; Write Header
  1. W:$D(IOF) @IOF
  1. W !!
  1. W "The following PCC Data Items will be prompted for for each visit created:"
  1. S X=0 F S X=$O(APCDCSEL(X)) Q:X'=+X W !?10,$P(^APCDTKW(APCDCSEL(X),0),U),?16,$S($P(^APCDTKW(APCDCSEL(X),0),U,12)]"":$P(^APCDTKW(APCDCSEL(X),0),U,12),1:$P(^APCDTKW(APCDCSEL(X),0),U,6))
  1. D ^APCDEIN
  1. Q:APCDFLG
  1. GETLOC ; GET LOCATION OF ENCOUNTER
  1. W !!
  1. S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)
  1. S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
  1. G:Y<0 EOJ
  1. S APCDLOC=+Y
  1. ;
  1. GETTYPE ; GET TYPE OF ENCOUNTER
  1. S APCDTYPE=""
  1. K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
  1. I $D(APCDDEFT),APCDDEFT]"" S DIR("B")=APCDDEFT
  1. S DIR(0)="9000010,.03O",DIR("A")="TYPE" D ^DIR K DIR
  1. I $D(DIRUT) S X="" G GETLOC
  1. S APCDTYPE=Y
  1. ;
  1. GETCAT ; GET SERVICE CATEGORY
  1. S APCDCAT=""
  1. K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
  1. I $D(APCDDEFS),APCDDEFS]"" S DIR("B")=APCDDEFS
  1. S DIR(0)="9000010,.07O",DIR("A")="SERVICE CATEGORY" D ^DIR K DIR
  1. I $D(DIRUT) S X="" G GETTYPE
  1. S APCDCAT=Y
  1. ;
  1. I APCDCAT'="A" G PROC1
  1. ;
  1. GETCLIN ;
  1. S APCDPECL=""
  1. K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA,DIC
  1. I $D(APCDDEFC),APCDDEFC]"" S DIC("B")=$P(^DIC(40.7,APCDDEFC,0),U)
  1. S DIC=40.7,DIC(0)="AEMQ",DIC("A")="Enter CLINIC: " D ^DIC K DIC
  1. I Y<0 G GETCAT
  1. S APCDPECL=+Y
  1. PROC1 ;********* loop through patients
  1. ;get template or individual patient names
  1. S APCDPEPP=""
  1. S DIR(0)="SO^C:Enter a COHORT (template) of Patient Names;I:Be prompted for Individual Patient Names",DIR("A")="Would you like to",DIR("B")="I" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) G EOJ
  1. I Y="C" D G EOJ
  1. .D GETTEMP G:APCDTEMP="" EOJ S APCDPEX=0 F S APCDPEX=$O(^DIBT(APCDTEMP,1,APCDPEX)) Q:APCDPEX="" S APCDPAT=APCDPEX D
  1. ..D INAC^APCDEA(APCDPAT,.X)
  1. ..I 'X S APCDPAT="" Q
  1. ..D PROCESS
  1. .Q
  1. S APCDPAT="" F D GETPAT Q:APCDPAT="" D PROCESS
  1. D EOJ
  1. Q
  1. GETDATE ; GET DATE OF ENCOUNTER
  1. S APCDDATE=""
  1. W !!,"VISIT/ADMIT DATE: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X=""
  1. Q:X=""!(X="^")
  1. S %DT="ET" D ^%DT G:Y<0 GETDATE
  1. I Y>DT W " <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
  1. K APCDODAT
  1. S APCDDATE=X
  1. GETTIME ;
  1. S APCDTIME=""
  1. I APCDTYPE="C"!("CNT"[APCDCAT) S APCDTIME="12:00"
  1. W !,"TIME OF VISIT: ",$S(APCDTIME]"":APCDTIME_"// ",1:"") R X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" S:X="" X=APCDTIME
  1. S APCDTIME=""
  1. I X="^" S APCDDATE="" Q
  1. I X="" W APCDBEEP," Time Required!" G GETTIME
  1. I X["?" W !,"Enter time of visit, or 'D' for default." G GETTIME
  1. I X="D" S X="12:00" W " ",X
  1. EDTIME S APCDTIME=X,X=APCDDATE_"@"_APCDTIME
  1. X ^TMP("APCD",$J,"APCDDATE")
  1. I '$D(X) W APCDBEEP G GETDATE
  1. I X="-1" W ! G GETDATE
  1. S APCDDATE=X
  1. Q
  1. GETPAT ; GET PATIENT
  1. D GETPAT^APCDEA
  1. Q
  1. ;
  1. PROCESS ; PROCESS PATIENT
  1. W:$D(IOF) @IOF W !!,"Generating PCC Visit for ",$P(^DPT(APCDPAT,0),U)," DOB: ",$$FMTE^XLFDT($P(^DPT(APCDPAT,0),U,3)),!!
  1. D GETDATE
  1. I APCDDATE="" Q
  1. D ^APCDPE2
  1. Q
  1. ;
  1. GETTEMP ;
  1. ;
  1. W ! S DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
  1. I Y=-1 S APCDTEMP="" Q
  1. S APCDTEMP=+Y
  1. Q
  1. EOJ ; END OF JOB
  1. D ^APCDEKL
  1. Q