APCDEHI ; IHS/CMI/LAB - enter historical inpatient data ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
HDR ;
F APCDJ=1:1:7 S APCDX=$P($T(TEXT+APCDJ),";;",2) W !?80-$L(APCDX)\2,APCDX
W !
K APCDX,APCDJ
K DIC S APCDHINP=1,APCDTPLT=0,APCDTPLT("NAME")="MNEMONIC",APCDCAT="H" D ^APCDEIN
S APCDLOC="" F APCDL=0:0 D GETLOC Q:APCDLOC="" S APCDTYPE="" F APCDL=0:0 D GETTYPE Q:APCDTYPE="" S APCDDATE="" F APCDL=0:0 D GETDATE Q:APCDDATE="" S APCDPAT="" D GETPAT D:APCDPAT]"" PROCESS
D EOJ
Q
;
GETLOC ; GET LOCATION OF ENCOUNTER
S APCDLOC=""
S DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDLOC=+Y
Q
;
GETTYPE ; GET TYPE OF ENCOUNTER
S APCDTYPE=""
K DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
S DIR(0)="9000010,.03O",DIR("A")="TYPE" D ^DIR K DIR
S:$D(DIRUT) X=""
S APCDTYPE=X
K DIR,DIRUT,DIROUT,DTOUT,DUOUT
Q
;
;
GETDATE ; GET DATE OF ENCOUNTER
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=" ",$D(APCDODAT),APCDODAT]"" S X=APCDODAT W X
S %DT="ET" D ^%DT G:Y<0 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
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 AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
Q
;
PROCESS ; PROCESS PATIENT
D ^APCDEHI2
I $D(APCDAPP) W !!,"Returning to Add Mode.",! K APCDAPP
Q
;
EOJ ; END OF JOB
D ^APCDEKL
K APCDHINP,APCDDOB,APCDDOD,APCDSEX,APCDPAT,APCDVSIT
K DTOUT,DUOUT,DIR
Q
TEXT ;
;;
;;PCC Data Entry Module
;;
;;***************************************
;;* Historical Inpatient ENTER Mode *
;;***************************************
;;
APCDEHI ; IHS/CMI/LAB - enter historical inpatient data ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
HDR ;
+1 FOR APCDJ=1:1:7
SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)
WRITE !?80-$LENGTH(APCDX)\2,APCDX
+2 WRITE !
+3 KILL APCDX,APCDJ
+4 KILL DIC
SET APCDHINP=1
SET APCDTPLT=0
SET APCDTPLT("NAME")="MNEMONIC"
SET APCDCAT="H"
DO ^APCDEIN
+5 SET APCDLOC=""
FOR APCDL=0:0
DO GETLOC
IF APCDLOC=""
QUIT
SET APCDTYPE=""
FOR APCDL=0:0
DO GETTYPE
IF APCDTYPE=""
QUIT
SET APCDDATE=""
FOR APCDL=0:0
DO GETDATE
IF APCDDATE=""
QUIT
SET APCDPAT=""
DO GETPAT
IF APCDPAT]""
DO PROCESS
+6 DO EOJ
+7 QUIT
+8 ;
GETLOC ; GET LOCATION OF ENCOUNTER
+1 SET APCDLOC=""
+2 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+3 IF Y<0
QUIT
+4 SET APCDLOC=+Y
+5 QUIT
+6 ;
GETTYPE ; GET TYPE OF ENCOUNTER
+1 SET APCDTYPE=""
+2 KILL DTOUT,DUOUT,DIRUT,DIROUT,DIR,DA
+3 SET DIR(0)="9000010,.03O"
SET DIR("A")="TYPE"
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET X=""
+5 SET APCDTYPE=X
+6 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
+7 QUIT
+8 ;
+9 ;
GETDATE ; GET DATE OF ENCOUNTER
+1 IF APCDDATE
SET APCDODAT=APCDDATE\1
+2 SET APCDDATE=""
+3 WRITE !,"VISIT/ADMIT DATE: "
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET X=""
+4 IF X=""!(X="^")
QUIT
+5 IF X=" "
IF $DATA(APCDODAT)
IF APCDODAT]""
SET X=APCDODAT
WRITE X
+6 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+7 KILL APCDODAT
+8 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 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 ; re-set days of age to visit date-dob
IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+8 QUIT
+9 ;
PROCESS ; PROCESS PATIENT
+1 DO ^APCDEHI2
+2 IF $DATA(APCDAPP)
WRITE !!,"Returning to Add Mode.",!
KILL APCDAPP
+3 QUIT
+4 ;
EOJ ; END OF JOB
+1 DO ^APCDEKL
+2 KILL APCDHINP,APCDDOB,APCDDOD,APCDSEX,APCDPAT,APCDVSIT
+3 KILL DTOUT,DUOUT,DIR
+4 QUIT
TEXT ;
+1 ;;
+2 ;;PCC Data Entry Module
+3 ;;
+4 ;;***************************************
+5 ;;* Historical Inpatient ENTER Mode *
+6 ;;***************************************
+7 ;;
