APCDEAP ; IHS/CMI/LAB - APPEND MODE ;
;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
;
; APCDFLG=0 ... RUN
; APCDFLG=1 ... ERROR
;
; APCDMODE=A ... ADD
; APCDMODE=M ... MOD
;
HDR ; Write Header
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
W !!
D ^APCDEIN
Q:APCDFLG
I '$D(APCDPARM) D ^APCDVAR
S APCDPAT="",APCDNOXV=""
F D GETPAT Q:APCDPAT="" D GETVISIT I APCDVSIT D MNEPROC
D EOJ
Q
;
GETPAT ;EP - GET PATIENT
W !
S APCDPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDPAT=+Y
I APCDPAT S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE
I DUZ("AG")="I" D ^APCDEMDI
Q
;
GETVISIT ;EP - GET VISIT
K APCDCAT,APCDTYPE,APCDTLOC,APCDTTYP,APCDTCAT,APCDTVST
S APCDVSIT=""
D ^APCDVLK
;I APCDVSIT S DA=APCDVSIT,DIE="^AUPNVSIT(",DR=".13////"_DT D ^DIE K DA,DIE,DR
I APCDVSIT S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
I APCDVSIT,AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
I APCDVSIT K DR S APCDVDSP=APCDVSIT D ^APCDEWHA K APCDVDSP
Q
;
MNEPROC ;EP - PROCESS MNEMONICS UNTIL DONE
S APCDMPQ=0
F D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q
D EP^APCDKDE
D GETMNEK
K APCDMPQ
Q
;
GETMNE ; GET MNEMONIC
W !
S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^APCDTKW(+Y,0),U))<5,'$P(^(0),U,7)" D ^DIC K DIC("A"),DIC("S")
I Y<0 D CHECK Q
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
K APCDMOD
D ^APCDEA3
I $D(APCDEQX) D ^APCDEQX I $D(APCDEQX) S APCDMPQ=1 Q
I $D(APCDMOD) W !!,"Switching to Modify Mode for ONE Mnemonic ONLY!" S APCDMODE="M",APCDVLK=APCDVSIT D GETMNE K APCDVLK,APCDMOD S APCDMODE="A" W !!,"Switching back to ENTER Mode!" Q
Q
;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
K APCDVSIT,APCDX,APCDEQX
Q
;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
Q:$D(APCDMOD)
S APCDMPQ=1
I $P(^AUPNVSIT(APCDVSIT,0),U,7)="E" Q
K APCDNOCL D ^APCDVCHK
I APCDMODE'="M",'$D(^AUPNVPOV("AD",APCDVSIT)),'$D(^AUPNVPRN("AD",APCDVSIT)) W !,"PV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q
I APCDMODE'="M",'$D(^AUPNVPRV("AD",APCDVSIT)) W !,"PRV mnemonic required!",!,APCDBEEP S:'$D(DTOUT) APCDMPQ=0 Q
I APCDMODE'="M",$D(APCDNOCL) W !,"CL mnemonic required!",!,$C(7) S:'$D(DTOUT) APCDMPQ=0 K APCDNOCL Q
I APCDMODE'="M",$P(^AUPNVSIT(APCDVSIT,0),U,7)="H",$P(^(0),U,3)'="C",'$D(^AUPNVINP("AD",APCDVSIT)) W !,"IP Mnemonic required on Hospitalizations!",$C(7) S:'$D(DTOUT) APCDMPQ=0 Q
I APCDMODE'="M",$P(^AUPNVSIT(APCDVSIT,0),U,3)="C",'$D(^AUPNVCHS("AD",APCDVSIT)) W !,"CHA, CHH or CHI mnemonic required with Contract Visits!",$C(7) S:'$D(DTOUT) APCDMPQ=0 Q
D DEDT^APCDEA2(APCDVSIT) I $P(APCDPARM,U,5)="Y",'$D(^APCDFORM("AB",APCDVSIT)) S APCDFV=APCDVSIT D ^APCDFORM K APCDFV
I $P(APCDPARM,U,5)="Y",$D(^AUPNVTC("AD",APCDVSIT)) S APCDFV=APCDVSIT D ^APCDFCTC K APCDFV ;IHS/CMI/LAB - patch 2,4 added this line for tc tracking
Q
;
EOJ ; END OF JOB
D ^APCDEKL
K DX,S,A,POP,IOY,%,%DT,X,Y,DI,DIGG,DIPGM,DISYS,DI,%1,DQ
K APCDEQX,APCDMPQ,APCDNOXV
Q
TEXT ;
;;PCC Data Entry Module
;;
;;***************
;;* APPEND Mode *
;;***************
Q
APCDEAP ; IHS/CMI/LAB - APPEND MODE ;
+1 ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
+2 ;
+3 ; APCDFLG=0 ... RUN
+4 ; APCDFLG=1 ... ERROR
+5 ;
+6 ; APCDMODE=A ... ADD
+7 ; APCDMODE=M ... MOD
+8 ;
HDR ; Write Header
+1 IF $DATA(IOF)
WRITE @IOF
+2 FOR APCDJ=1:1:5
SET APCDX=$PIECE($TEXT(TEXT+APCDJ),";;",2)
WRITE !?80-$LENGTH(APCDX)\2,APCDX
+3 KILL APCDX,APCDJ
+4 WRITE !!
+5 DO ^APCDEIN
+6 IF APCDFLG
QUIT
+7 IF '$DATA(APCDPARM)
DO ^APCDVAR
+8 SET APCDPAT=""
SET APCDNOXV=""
+9 FOR
DO GETPAT
IF APCDPAT=""
QUIT
DO GETVISIT
IF APCDVSIT
DO MNEPROC
+10 DO EOJ
+11 QUIT
+12 ;
GETPAT ;EP - 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 SET APCDPAT=+Y
+6 IF APCDPAT
SET DIE="^AUPNPAT("
SET DR=".16///TODAY"
SET DA=APCDPAT
DO ^DIE
+7 IF DUZ("AG")="I"
DO ^APCDEMDI
+8 QUIT
+9 ;
GETVISIT ;EP - GET VISIT
+1 KILL APCDCAT,APCDTYPE,APCDTLOC,APCDTTYP,APCDTCAT,APCDTVST
+2 SET APCDVSIT=""
+3 DO ^APCDVLK
+4 ;I APCDVSIT S DA=APCDVSIT,DIE="^AUPNVSIT(",DR=".13////"_DT D ^DIE K DA,DIE,DR
+5 IF APCDVSIT
SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+6 ; re-set days of age to visit date-dob
IF APCDVSIT
IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+7 IF APCDVSIT
KILL DR
SET APCDVDSP=APCDVSIT
DO ^APCDEWHA
KILL APCDVDSP
+8 QUIT
+9 ;
MNEPROC ;EP - PROCESS MNEMONICS UNTIL DONE
+1 SET APCDMPQ=0
+2 FOR
DO GETMNE
IF $DATA(APCDEQX)
DO CHKEHR2^APCDVCHK
IF APCDMPQ
QUIT
+3 DO EP^APCDKDE
+4 DO GETMNEK
+5 KILL APCDMPQ
+6 QUIT
+7 ;
GETMNE ; GET MNEMONIC
+1 WRITE !
+2 SET DIC="^APCDTKW("
SET DIC(0)="AEMQ"
SET DIC("A")="MNEMONIC: "
SET DIC("S")="I $L($P(^APCDTKW(+Y,0),U))<5,'$P(^(0),U,7)"
DO ^DIC
KILL DIC("A"),DIC("S")
+3 IF Y<0
DO CHECK
QUIT
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 KILL APCDMOD
+6 DO ^APCDEA3
+7 IF $DATA(APCDEQX)
DO ^APCDEQX
IF $DATA(APCDEQX)
SET APCDMPQ=1
QUIT
+8 IF $DATA(APCDMOD)
WRITE !!,"Switching to Modify Mode for ONE Mnemonic ONLY!"
SET APCDMODE="M"
SET APCDVLK=APCDVSIT
DO GETMNE
KILL APCDVLK,APCDMOD
SET APCDMODE="A"
WRITE !!,"Switching back to ENTER Mode!"
QUIT
+9 QUIT
+10 ;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
+1 KILL APCDVSIT,APCDX,APCDEQX
+2 QUIT
+3 ;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
+1 IF $DATA(APCDMOD)
QUIT
+2 SET APCDMPQ=1
+3 IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,7)="E"
QUIT
+4 KILL APCDNOCL
DO ^APCDVCHK
+5 IF APCDMODE'="M"
IF '$DATA(^AUPNVPOV("AD",APCDVSIT))
IF '$DATA(^AUPNVPRN("AD",APCDVSIT))
WRITE !,"PV mnemonic required!",!,APCDBEEP
IF '$DATA(DTOUT)
SET APCDMPQ=0
QUIT
+6 IF APCDMODE'="M"
IF '$DATA(^AUPNVPRV("AD",APCDVSIT))
WRITE !,"PRV mnemonic required!",!,APCDBEEP
IF '$DATA(DTOUT)
SET APCDMPQ=0
QUIT
+7 IF APCDMODE'="M"
IF $DATA(APCDNOCL)
WRITE !,"CL mnemonic required!",!,$CHAR(7)
IF '$DATA(DTOUT)
SET APCDMPQ=0
KILL APCDNOCL
QUIT
+8 IF APCDMODE'="M"
IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,7)="H"
IF $PIECE(^(0),U,3)'="C"
IF '$DATA(^AUPNVINP("AD",APCDVSIT))
WRITE !,"IP Mnemonic required on Hospitalizations!",$CHAR(7)
IF '$DATA(DTOUT)
SET APCDMPQ=0
QUIT
+9 IF APCDMODE'="M"
IF $PIECE(^AUPNVSIT(APCDVSIT,0),U,3)="C"
IF '$DATA(^AUPNVCHS("AD",APCDVSIT))
WRITE !,"CHA, CHH or CHI mnemonic required with Contract Visits!",$CHAR(7)
IF '$DATA(DTOUT)
SET APCDMPQ=0
QUIT
+10 DO DEDT^APCDEA2(APCDVSIT)
IF $PIECE(APCDPARM,U,5)="Y"
IF '$DATA(^APCDFORM("AB",APCDVSIT))
SET APCDFV=APCDVSIT
DO ^APCDFORM
KILL APCDFV
+11 ;IHS/CMI/LAB - patch 2,4 added this line for tc tracking
IF $PIECE(APCDPARM,U,5)="Y"
IF $DATA(^AUPNVTC("AD",APCDVSIT))
SET APCDFV=APCDVSIT
DO ^APCDFCTC
KILL APCDFV
+12 QUIT
+13 ;
EOJ ; END OF JOB
+1 DO ^APCDEKL
+2 KILL DX,S,A,POP,IOY,%,%DT,X,Y,DI,DIGG,DIPGM,DISYS,DI,%1,DQ
+3 KILL APCDEQX,APCDMPQ,APCDNOXV
+4 QUIT
TEXT ;
+1 ;;PCC Data Entry Module
+2 ;;
+3 ;;***************
+4 ;;* APPEND Mode *
+5 ;;***************
+6 QUIT
