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