APCDEA2 ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;
;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
; Generate VISIT, then process MNEMONICS/TEMPLATE
;BJPC v1.0 patch 1
START ;
S APCDX=""
I $D(APCDLPAT),APCDLPAT=APCDPAT,$D(APCDLDAT),APCDLDAT=APCDDATE,$D(APCDLVST),'APCDTPLT D SAMEPAT
S APCDLPAT=APCDPAT
S APCDLDAT=APCDDATE
I APCDX=1 D MNEPROC Q
Q:APCDX=2
K APCDLVST,APCDCLN,ZTSK
I $D(APCDTVST) S APCDTYPE=APCDTTYP,APCDCAT=APCDTCAT,APCDLOC=APCDTLOC K APCDTVST,APCDTTYP,APCDTCAT,APCDTLOC
K APCDALVR D ^APCDALV
I $D(APCDAFLG)#2,APCDAFLG=2 W $C(7),!,"VISIT date not valid for current patient!",! S APCDFLG=1 Q
Q:APCDVSIT=""
;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")'<$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR
;above added for EHR and auditing of visits, d/e created
;visits are always set to "R"
S APCDLVST=APCDVSIT
S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE
;S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT D ^DIE K DR,DA,DIE
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X
I APCDTPLT S APCDMNE=APCDTPLT D ^APCDEA3,GETMNEK Q
K DR
I $P($G(APCDPARM),U,18)'="N" S APCDVDSP=APCDVSIT D:$D(APCDVSIT("NEW")) ^APCDVDSP D:'$D(APCDVSIT("NEW")) ^APCDEWHA K APCDVDSP
I APCDTYPE'="C","TC"'[APCDCAT,'$D(APCDVSIT("NEW")) S X="TM" D GET1
I $P($G(APCDPARM),U,16)="Y",$E($P(^AUTTLOC(APCDLOC,0),U,10),5,6)>49 S X="OLOC" D GET1
I $D(APCDMINI),APCDTYPE'="C" D
.S X=$S(APCDCAT'="H":"CL",1:"IP") D GET1
.S APCDAMN=0 F S APCDAMN=$O(^APCDSITE(DUZ(2),12,APCDAMN)) Q:APCDAMN'=+APCDAMN S X=$P(^APCDTKW($P(^APCDSITE(DUZ(2),12,APCDAMN,0),U),0),U) D GET1
.F X="PRV","PV" D GET1
.Q
I APCDCAT="H",APCDTYPE'="C",'$D(APCDMINI),'$D(^AUPNVINP("AD",APCDVSIT)) S X="IP" D GET1
D MNEPROC
Q
;
MNEPROC ; PROCESS MNEMONICS UNTIL DONE
S APCDMPQ=0
F D GETMNE D:$D(APCDEQX) CHKEHR2^APCDVCHK I APCDMPQ Q
I $G(APCDVSIT) D EP^APCDKDE
D GETMNEK
K APCDMPQ,APCDREGU
W !
Q
;
GETMNE ; GET MNEMONIC
W !
K DIC,I,D,%D,X,Y,DIADD,DLAYGO
S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^APCDTKW(+Y,0),U))<5" 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",APCDVSIT=APCDLVST,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,APCDREGU
Q
;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
Q:$D(APCDMOD)
S APCDMPQ=1
K APCDNOCL D ^APCDVCHK
Q:"EX"[$P(^AUPNVSIT(APCDVSIT,0),U,7)
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
Q:'APCDMPQ
D DEDT(APCDLVST) I $P(APCDPARM,U,5)="Y",'$D(^APCDFORM("AB",APCDLVST)) S APCDFV=APCDLVST 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 added this line to do tc tracking
Q
;
GET1 ;
W !!
K DIC,D,I,%D
S DIC="^APCDTKW(",DIC(0)="EMQX" D ^DIC K DIC
I Y<0 W !!,$C(7),$C(7),X," Mnemonic is Missing - Notify your Supervisor!" K DIC,X Q
S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
D ^APCDEA3
Q
;
SAMEPAT ; SAME PATIENT
K DIR,DIRUT,DIROUT
S APCDX=+^AUPNVSIT(APCDLVST,0),APCDX=$E(APCDX,4,5)_"-"_$E(APCDX,6,7)_"-"_(1700+$E(APCDX,1,3))_$S($P(APCDX,".",2)]"":"@"_$P(APCDX,".",2),1:"")
W !!,"You have reselected the same patient.",!
W !,"Last VISIT is ",APCDX,!
S DIR("A")="Choose",DIR(0)="S^1:Modify last VISIT;2:Append to last VISIT;3:Create new VISIT;4:Quit"
D ^DIR
S APCDX=+Y
I $D(DIRUT) S APCDX=4
K DIR,DIRUT,DIROUT,DUOUT,DTOUT
D @("SAMEPAT"_APCDX)
Q
SAMEPAT1 ;
W " Switching to Modify Mode."
S APCDMODE="M",APCDVSIT=APCDLVST,APCDVLK=APCDVSIT D MNEPROC S APCDMODE="A",APCDX=2 K APCDVLK
W !!,"Returning to Enter Mode.",!
Q
SAMEPAT2 ;
W " Switching to Append Mode."
S APCDVSIT=APCDLVST,APCDX=1,APCDAPP=1
Q
SAMEPAT3 ;
W " Creating new VISIT, still in Add Mode."
S APCDX=3,APCDADD=1
Q
SAMEPAT4 ;
W " Quit",!
S APCDX=2
Q
;
DEDT(VISIT) ;EP - update 1105 of visit
I '$G(VISIT) Q
I '$D(^AUPNVSIT(VISIT)) Q
Q:$P($G(^AUPNVSIT(VISIT,11)),U,5)]""
D ^XBFMK
S DA=VISIT,DIE="^AUPNVSIT(",DR="1105////"_DT D ^DIE
D ^XBFMK
Q
APCDEA2 ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;
+1 ;;2.0;IHS PCC SUITE;**17**;MAY 14, 2009;Build 18
+2 ; Generate VISIT, then process MNEMONICS/TEMPLATE
+3 ;BJPC v1.0 patch 1
START ;
+1 SET APCDX=""
+2 IF $DATA(APCDLPAT)
IF APCDLPAT=APCDPAT
IF $DATA(APCDLDAT)
IF APCDLDAT=APCDDATE
IF $DATA(APCDLVST)
IF 'APCDTPLT
DO SAMEPAT
+3 SET APCDLPAT=APCDPAT
+4 SET APCDLDAT=APCDDATE
+5 IF APCDX=1
DO MNEPROC
QUIT
+6 IF APCDX=2
QUIT
+7 KILL APCDLVST,APCDCLN,ZTSK
+8 IF $DATA(APCDTVST)
SET APCDTYPE=APCDTTYP
SET APCDCAT=APCDTCAT
SET APCDLOC=APCDTLOC
KILL APCDTVST,APCDTTYP,APCDTCAT,APCDTLOC
+9 KILL APCDALVR
DO ^APCDALV
+10 IF $DATA(APCDAFLG)#2
IF APCDAFLG=2
WRITE $CHAR(7),!,"VISIT date not valid for current patient!",!
SET APCDFLG=1
QUIT
+11 IF APCDVSIT=""
QUIT
+12 ;I $D(APCDVSIT("NEW")),$P(^APCCCTRL(DUZ(2),0),U,12)]"",$P($P(^AUPNVSIT(APCDVSIT,0),U),".")'<$P(^APCCCTRL(DUZ(2),0),U,12) S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="1111///R" D ^DIE K DIE,DA,DR
+13 ;above added for EHR and auditing of visits, d/e created
+14 ;visits are always set to "R"
+15 SET APCDLVST=APCDVSIT
+16 SET DIE="^AUPNPAT("
SET DR=".16///TODAY"
SET DA=APCDPAT
DO ^DIE
+17 ;S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT D ^DIE K DR,DA,DIE
+18 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+19 IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+20 IF APCDTPLT
SET APCDMNE=APCDTPLT
DO ^APCDEA3
DO GETMNEK
QUIT
+21 KILL DR
+22 IF $PIECE($GET(APCDPARM),U,18)'="N"
SET APCDVDSP=APCDVSIT
IF $DATA(APCDVSIT("NEW"))
DO ^APCDVDSP
IF '$DATA(APCDVSIT("NEW"))
DO ^APCDEWHA
KILL APCDVDSP
+23 IF APCDTYPE'="C"
IF "TC"'[APCDCAT
IF '$DATA(APCDVSIT("NEW"))
SET X="TM"
DO GET1
+24 IF $PIECE($GET(APCDPARM),U,16)="Y"
IF $EXTRACT($PIECE(^AUTTLOC(APCDLOC,0),U,10),5,6)>49
SET X="OLOC"
DO GET1
+25 IF $DATA(APCDMINI)
IF APCDTYPE'="C"
Begin DoDot:1
+26 SET X=$SELECT(APCDCAT'="H":"CL",1:"IP")
DO GET1
+27 SET APCDAMN=0
FOR
SET APCDAMN=$ORDER(^APCDSITE(DUZ(2),12,APCDAMN))
IF APCDAMN'=+APCDAMN
QUIT
SET X=$PIECE(^APCDTKW($PIECE(^APCDSITE(DUZ(2),12,APCDAMN,0),U),0),U)
DO GET1
+28 FOR X="PRV","PV"
DO GET1
+29 QUIT
End DoDot:1
+30 IF APCDCAT="H"
IF APCDTYPE'="C"
IF '$DATA(APCDMINI)
IF '$DATA(^AUPNVINP("AD",APCDVSIT))
SET X="IP"
DO GET1
+31 DO MNEPROC
+32 QUIT
+33 ;
MNEPROC ; PROCESS MNEMONICS UNTIL DONE
+1 SET APCDMPQ=0
+2 FOR
DO GETMNE
IF $DATA(APCDEQX)
DO CHKEHR2^APCDVCHK
IF APCDMPQ
QUIT
+3 IF $GET(APCDVSIT)
DO EP^APCDKDE
+4 DO GETMNEK
+5 KILL APCDMPQ,APCDREGU
+6 WRITE !
+7 QUIT
+8 ;
GETMNE ; GET MNEMONIC
+1 WRITE !
+2 KILL DIC,I,D,%D,X,Y,DIADD,DLAYGO
+3 SET DIC="^APCDTKW("
SET DIC(0)="AEMQ"
SET DIC("A")="MNEMONIC: "
SET DIC("S")="I $L($P(^APCDTKW(+Y,0),U))<5"
DO ^DIC
KILL DIC("A"),DIC("S")
+4 IF Y<0
DO CHECK
QUIT
+5 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+6 KILL APCDMOD
+7 DO ^APCDEA3
+8 IF $DATA(APCDEQX)
DO ^APCDEQX
IF $DATA(APCDEQX)
SET APCDMPQ=1
QUIT
+9 IF $DATA(APCDMOD)
WRITE !!,"Switching to Modify Mode for ONE Mnemonic ONLY!"
SET APCDMODE="M"
SET APCDVSIT=APCDLVST
SET APCDVLK=APCDVSIT
DO GETMNE
KILL APCDVLK,APCDMOD
SET APCDMODE="A"
WRITE !!,"Switching back to ENTER Mode!"
QUIT
+10 QUIT
+11 ;
GETMNEK ; KILL GETMNE SPECIFIC VARIABLES
+1 KILL APCDVSIT,APCDX,APCDEQX,APCDREGU
+2 QUIT
+3 ;
CHECK ; SEE IF PV AND PRO ENTERED CORRECTLY
+1 IF $DATA(APCDMOD)
QUIT
+2 SET APCDMPQ=1
+3 KILL APCDNOCL
DO ^APCDVCHK
+4 IF "EX"[$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
QUIT
+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 IF 'APCDMPQ
QUIT
+11 DO DEDT(APCDLVST)
IF $PIECE(APCDPARM,U,5)="Y"
IF '$DATA(^APCDFORM("AB",APCDLVST))
SET APCDFV=APCDLVST
DO ^APCDFORM
KILL APCDFV
+12 ;IHS/CMI/LAB - patch 2 added this line to do tc tracking
IF $PIECE(APCDPARM,U,5)="Y"
IF $DATA(^AUPNVTC("AD",APCDVSIT))
SET APCDFV=APCDVSIT
DO ^APCDFCTC
KILL APCDFV
+13 QUIT
+14 ;
GET1 ;
+1 WRITE !!
+2 KILL DIC,D,I,%D
+3 SET DIC="^APCDTKW("
SET DIC(0)="EMQX"
DO ^DIC
KILL DIC
+4 IF Y<0
WRITE !!,$CHAR(7),$CHAR(7),X," Mnemonic is Missing - Notify your Supervisor!"
KILL DIC,X
QUIT
+5 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+6 DO ^APCDEA3
+7 QUIT
+8 ;
SAMEPAT ; SAME PATIENT
+1 KILL DIR,DIRUT,DIROUT
+2 SET APCDX=+^AUPNVSIT(APCDLVST,0)
SET APCDX=$EXTRACT(APCDX,4,5)_"-"_$EXTRACT(APCDX,6,7)_"-"_(1700+$EXTRACT(APCDX,1,3))_$SELECT($PIECE(APCDX,".",2)]"":"@"_$PIECE(APCDX,".",2),1:"")
+3 WRITE !!,"You have reselected the same patient.",!
+4 WRITE !,"Last VISIT is ",APCDX,!
+5 SET DIR("A")="Choose"
SET DIR(0)="S^1:Modify last VISIT;2:Append to last VISIT;3:Create new VISIT;4:Quit"
+6 DO ^DIR
+7 SET APCDX=+Y
+8 IF $DATA(DIRUT)
SET APCDX=4
+9 KILL DIR,DIRUT,DIROUT,DUOUT,DTOUT
+10 DO @("SAMEPAT"_APCDX)
+11 QUIT
SAMEPAT1 ;
+1 WRITE " Switching to Modify Mode."
+2 SET APCDMODE="M"
SET APCDVSIT=APCDLVST
SET APCDVLK=APCDVSIT
DO MNEPROC
SET APCDMODE="A"
SET APCDX=2
KILL APCDVLK
+3 WRITE !!,"Returning to Enter Mode.",!
+4 QUIT
SAMEPAT2 ;
+1 WRITE " Switching to Append Mode."
+2 SET APCDVSIT=APCDLVST
SET APCDX=1
SET APCDAPP=1
+3 QUIT
SAMEPAT3 ;
+1 WRITE " Creating new VISIT, still in Add Mode."
+2 SET APCDX=3
SET APCDADD=1
+3 QUIT
SAMEPAT4 ;
+1 WRITE " Quit",!
+2 SET APCDX=2
+3 QUIT
+4 ;
DEDT(VISIT) ;EP - update 1105 of visit
+1 IF '$GET(VISIT)
QUIT
+2 IF '$DATA(^AUPNVSIT(VISIT))
QUIT
+3 IF $PIECE($GET(^AUPNVSIT(VISIT,11)),U,5)]""
QUIT
+4 DO ^XBFMK
+5 SET DA=VISIT
SET DIE="^AUPNVSIT("
SET DR="1105////"_DT
DO ^DIE
+6 DO ^XBFMK
+7 QUIT
