- 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
