APCDPE2 ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
; Generate VISIT, then process MNEMONICS/TEMPLATE
;
START ;
S Y=APCDPAT D ^AUPNPAT
S APCDCLN=APCDPECL
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=""
S APCDLVST=APCDVSIT
S DIE="^AUPNPAT(",DR=".16///TODAY",DA=APCDPAT D ^DIE
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
I AUPNDOB]"" S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X
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 APCDCAT="H",APCDTYPE'="C",'$D(^AUPNVINP("AD",APCDVSIT)) S X="IP" D GET1
S APCDPEH=0 F S APCDPEH=$O(APCDCSEL(APCDPEH)) Q:APCDPEH'=+APCDPEH S X=APCDCSEL(APCDPEH),X=$P(^APCDTKW(X,0),U) D GET1
W !!,"You may now enter other data using any of the data entry mnemonics.",!,"To display the visit type DISP, to display a health summary type DHS.",!,"Press enter to exit.",!
D MNEPROC
Q
;
MNEPROC ; PROCESS MNEMONICS UNTIL DONE
S APCDMPQ=0
F D GETMNE Q:APCDMPQ
I $G(APCDVSIT) D EP^APCDKDE
D GETMNEK
K APCDMPQ,APCDREGU
W !
Q
;
GETMNE ; GET MNEMONIC
W !
S DIC="^APCDTKW(",DIC(0)="AEMQ",DIC("A")="MNEMONIC: ",DIC("S")="I $L($P(^(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^APCDEA2(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 !!
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
;
APCDPE2 ; IHS/CMI/LAB - DATA ENTRY ENTER CONT. ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ; Generate VISIT, then process MNEMONICS/TEMPLATE
+3 ;
START ;
+1 SET Y=APCDPAT
DO ^AUPNPAT
+2 SET APCDCLN=APCDPECL
+3 KILL APCDALVR
DO ^APCDALV
+4 IF $DATA(APCDAFLG)#2
IF APCDAFLG=2
WRITE $CHAR(7),!,"VISIT date not valid for current patient!",!
SET APCDFLG=1
QUIT
+5 IF APCDVSIT=""
QUIT
+6 SET APCDLVST=APCDVSIT
+7 SET DIE="^AUPNPAT("
SET DR=".16///TODAY"
SET DA=APCDPAT
DO ^DIE
+8 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+9 IF AUPNDOB]""
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+10 KILL DR
+11 IF $PIECE($GET(APCDPARM),U,18)'="N"
SET APCDVDSP=APCDVSIT
IF $DATA(APCDVSIT("NEW"))
DO ^APCDVDSP
IF '$DATA(APCDVSIT("NEW"))
DO ^APCDEWHA
KILL APCDVDSP
+12 IF APCDTYPE'="C"
IF "TC"'[APCDCAT
IF '$DATA(APCDVSIT("NEW"))
SET X="TM"
DO GET1
+13 IF $PIECE($GET(APCDPARM),U,16)="Y"
IF $EXTRACT($PIECE(^AUTTLOC(APCDLOC,0),U,10),5,6)>49
SET X="OLOC"
DO GET1
+14 IF APCDCAT="H"
IF APCDTYPE'="C"
IF '$DATA(^AUPNVINP("AD",APCDVSIT))
SET X="IP"
DO GET1
+15 SET APCDPEH=0
FOR
SET APCDPEH=$ORDER(APCDCSEL(APCDPEH))
IF APCDPEH'=+APCDPEH
QUIT
SET X=APCDCSEL(APCDPEH)
SET X=$PIECE(^APCDTKW(X,0),U)
DO GET1
+16 WRITE !!,"You may now enter other data using any of the data entry mnemonics.",!,"To display the visit type DISP, to display a health summary type DHS.",!,"Press enter to exit.",!
+17 DO MNEPROC
+18 QUIT
+19 ;
MNEPROC ; PROCESS MNEMONICS UNTIL DONE
+1 SET APCDMPQ=0
+2 FOR
DO GETMNE
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 SET DIC="^APCDTKW("
SET DIC(0)="AEMQ"
SET DIC("A")="MNEMONIC: "
SET DIC("S")="I $L($P(^(0),U))<5"
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 APCDVSIT=APCDLVST
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,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^APCDEA2(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 SET DIC="^APCDTKW("
SET DIC(0)="EMQX"
DO ^DIC
KILL DIC
+3 IF Y<0
WRITE !!,$CHAR(7),$CHAR(7),X," Mnemonic is Missing - Notify your Supervisor!"
KILL DIC,X
QUIT
+4 SET APCDMNE=+Y
SET APCDMNE("NAME")=$PIECE(Y,U,2)
+5 DO ^APCDEA3
+6 QUIT
+7 ;
