APCDEA ; 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
I $D(APCDMINI) F APCDJ=7:1:11 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX
I '$D(APCDMINI) 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
Q:APCDFLG
S APCDTPLT("NAME")="MNEMONIC",APCDTPLT=0,APCDLOC="" F D GETLOC Q:APCDLOC="" S APCDTYPE="" F D GETTYPE Q:APCDTYPE="" S APCDCAT="" F D GETCAT Q:APCDCAT="" D RESTOFIT
D EOJ
Q
;
RESTOFIT S APCDDATE="" F D GETDATE Q:APCDDATE="" S APCDPAT="" D GETPAT D:APCDPAT]"" PROCESS
Q
;
GETTMPLT ; GET TEMPLATE
Q
;
GETLOC ; GET LOCATION OF ENCOUNTER
Q:$D(APCDEXIT)
;S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)
S APCDLOC=""
I $G(APCDDEFL) S DIC("B")=APCDDEFL,DIC(0)="AMEBQN",DIC="^AUTTLOC(" D ^DIC K DIC
I '$G(APCDDEFL) S DIC(0)="AEMQ",DIC="^AUTTLOC(" D ^DIC K DIC
;S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
I $P(^AUTTLOC(+Y,0),U,21)]"" W !!,"That location has been inactivated! See you supervisor." G GETLOC
S APCDLOC=+Y
Q
;
GETTYPE ; GET TYPE OF ENCOUNTER
Q:$D(APCDEXIT)
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="" Q
S APCDTYPE=Y
Q
;
GETCAT ; GET SERVICE CATEGORY
Q:$D(APCDEXIT)
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="" Q
S APCDCAT=Y
Q
;
GETDATE ; GET DATE OF ENCOUNTER
Q:$D(APCDEXIT)
S:APCDDATE APCDODAT=APCDDATE\1
S APCDDATE=""
W !!,"VISIT/ADMIT DATE: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X=""
Q:X=""!(X="^")
I X="^^" S (APCDDATE,APCDLOC,APCDCAT,APCDTYPE,APCDEXIT)="" Q
I X=" ",$D(APCDODAT),APCDODAT]"" S X=APCDODAT ;W X
I X["@" W " <Date only, please - no time specification>",$C(7),$C(7) K X G GETDATE ;IHS/NPO/MAW - 12/13/05 ADDED LINE TO CORRECT IF USER PUT IN A DATE WITH TIME VICE DATE ONLY
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 ;EP - GET PATIENT
W !
S APCDPAT=""
I $G(APCDCAF("IN CAF W/PATIENT")) S APCDPAT=APCDCAF("IN CAF W/PATIENT") S Y=APCDPAT D ^AUPNPAT Q
I '$P($G(^APCDSITE(DUZ(2),0)),U,34) S AUPNLK("INAC")=1
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
D INAC(APCDPAT,.X) I 'X S APCDPAT="" Q
I DUZ("AG")="I" D ^APCDEMDI I $D(^APCDSITE(DUZ(2),11)) D ^APCDECC
Q
;
PROCESS ; PROCESS PATIENT
D ^APCDEA2
I $D(APCDAPP) W !!,"Returning to Add Mode.",! K APCDAPP
Q
;
EOJ ; END OF JOB
D ^APCDEKL
Q
INAC(P,RETVAL) ;EP - called to check to see if patient is inactive
S RETVAL=1
I $P($G(^AUPNPAT(P,41,DUZ(2),0)),U,3)]"" D Q
.W !!,"***Warning*** You have selected a patient with an Inactive Chart.",!
.K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue to add data for this patient",DIR("B")="Y" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S RETVAL=0
.S RETVAL=Y
Q
TEXT ;
;;PCC Data Entry Module
;;
;;**************
;;* ENTER Mode *
;;**************
;;
;;PCC Data Entry Module
;;
;;********************
;;* Mini ENTER Mode *
;;********************
APCDEA ; 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 IF $DATA(APCDMINI)
FOR APCDJ=7:1:11
SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)
WRITE !?80-$LENGTH(APCDX)\2,APCDX
+3 IF '$DATA(APCDMINI)
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 DO ^APCDEIN
+7 IF APCDFLG
QUIT
+8 SET APCDTPLT("NAME")="MNEMONIC"
SET APCDTPLT=0
SET APCDLOC=""
FOR
DO GETLOC
IF APCDLOC=""
QUIT
SET APCDTYPE=""
FOR
DO GETTYPE
IF APCDTYPE=""
QUIT
SET APCDCAT=""
FOR
DO GETCAT
IF APCDCAT=""
QUIT
DO RESTOFIT
+9 DO EOJ
+10 QUIT
+11 ;
RESTOFIT SET APCDDATE=""
FOR
DO GETDATE
IF APCDDATE=""
QUIT
SET APCDPAT=""
DO GETPAT
IF APCDPAT]""
DO PROCESS
+1 QUIT
+2 ;
GETTMPLT ; GET TEMPLATE
+1 QUIT
+2 ;
GETLOC ; GET LOCATION OF ENCOUNTER
+1 IF $DATA(APCDEXIT)
QUIT
+2 ;S APCDLOC="" I $D(APCDDEFL),APCDDEFL]"" S DIC("B")=$P(^DIC(4,APCDDEFL,0),U)
+3 SET APCDLOC=""
+4 IF $GET(APCDDEFL)
SET DIC("B")=APCDDEFL
SET DIC(0)="AMEBQN"
SET DIC="^AUTTLOC("
DO ^DIC
KILL DIC
+5 IF '$GET(APCDDEFL)
SET DIC(0)="AEMQ"
SET DIC="^AUTTLOC("
DO ^DIC
KILL DIC
+6 ;S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
+7 IF Y<0
QUIT
+8 IF $PIECE(^AUTTLOC(+Y,0),U,21)]""
WRITE !!,"That location has been inactivated! See you supervisor."
GOTO GETLOC
+9 SET APCDLOC=+Y
+10 QUIT
+11 ;
GETTYPE ; GET TYPE OF ENCOUNTER
+1 IF $DATA(APCDEXIT)
QUIT
+2 SET APCDTYPE=""
+3 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
+4 IF $DATA(APCDDEFT)
IF APCDDEFT]""
SET DIR("B")=APCDDEFT
+5 SET DIR(0)="9000010,.03O"
SET DIR("A")="TYPE"
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET X=""
QUIT
+7 SET APCDTYPE=Y
+8 QUIT
+9 ;
GETCAT ; GET SERVICE CATEGORY
+1 IF $DATA(APCDEXIT)
QUIT
+2 SET APCDCAT=""
+3 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
+4 IF $DATA(APCDDEFS)
IF APCDDEFS]""
SET DIR("B")=APCDDEFS
+5 SET DIR(0)="9000010,.07O"
SET DIR("A")="SERVICE CATEGORY"
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET X=""
QUIT
+7 SET APCDCAT=Y
+8 QUIT
+9 ;
GETDATE ; GET DATE OF ENCOUNTER
+1 IF $DATA(APCDEXIT)
QUIT
+2 IF APCDDATE
SET APCDODAT=APCDDATE\1
+3 SET APCDDATE=""
+4 WRITE !!,"VISIT/ADMIT DATE: "
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET X=""
+5 IF X=""!(X="^")
QUIT
+6 IF X="^^"
SET (APCDDATE,APCDLOC,APCDCAT,APCDTYPE,APCDEXIT)=""
QUIT
+7 ;W X
IF X=" "
IF $DATA(APCDODAT)
IF APCDODAT]""
SET X=APCDODAT
+8 ;IHS/NPO/MAW - 12/13/05 ADDED LINE TO CORRECT IF USER PUT IN A DATE WITH TIME VICE DATE ONLY
IF X["@"
WRITE " <Date only, please - no time specification>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+9 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+10 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+11 KILL APCDODAT
+12 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 ;EP - GET PATIENT
+1 WRITE !
+2 SET APCDPAT=""
+3 IF $GET(APCDCAF("IN CAF W/PATIENT"))
SET APCDPAT=APCDCAF("IN CAF W/PATIENT")
SET Y=APCDPAT
DO ^AUPNPAT
QUIT
+4 IF '$PIECE($GET(^APCDSITE(DUZ(2),0)),U,34)
SET AUPNLK("INAC")=1
+5 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y<0
QUIT
+7 IF $DATA(APCDPARM)
IF $PIECE(APCDPARM,U,3)="Y"
WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
QUIT
+8 SET APCDPAT=+Y
+9 DO INAC(APCDPAT,.X)
IF 'X
SET APCDPAT=""
QUIT
+10 IF DUZ("AG")="I"
DO ^APCDEMDI
IF $DATA(^APCDSITE(DUZ(2),11))
DO ^APCDECC
+11 QUIT
+12 ;
PROCESS ; PROCESS PATIENT
+1 DO ^APCDEA2
+2 IF $DATA(APCDAPP)
WRITE !!,"Returning to Add Mode.",!
KILL APCDAPP
+3 QUIT
+4 ;
EOJ ; END OF JOB
+1 DO ^APCDEKL
+2 QUIT
INAC(P,RETVAL) ;EP - called to check to see if patient is inactive
+1 SET RETVAL=1
+2 IF $PIECE($GET(^AUPNPAT(P,41,DUZ(2),0)),U,3)]""
Begin DoDot:1
+3 WRITE !!,"***Warning*** You have selected a patient with an Inactive Chart.",!
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue to add data for this patient"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
SET RETVAL=0
+6 SET RETVAL=Y
End DoDot:1
QUIT
+7 QUIT
TEXT ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;**************
+4 ;;* ENTER Mode *
+5 ;;**************
+6 ;;
+7 ;;PCC Data Entry Module
+8 ;;
+9 ;;********************
+10 ;;* Mini ENTER Mode *
+11 ;;********************
