ADEGRL31 ; IHS/HQT/MJL - DENTAL ENTRY PART 5 ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;**26**;APRIL 1999;Build 13
;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
DEL ;EP
Q:'$D(ADEV) D LIST^ADEGRL3
D1 W !!,"DELETE WHICH CODE? "
R X:DTIME S:'$T X="^"
Q:X=""!(X="^")
I X["?" W !,?5,"ENTER AN ADA CODE FROM THE ABOVE LIST TO DELETE",!,?10,"OR PRESS 'RETURN' TO DELETE NOTHING" G D1
I '$D(ADEV(X)) W *7,"??" G D1
K ADEV(X),ADEDES(X)
Q
EXIT ;EP
I (X="^Q")!(X="^") S ADENOUPD=1,Y=1 W !!,?20,"***DATA ENTRY ABORTED***",*7 H 1 Q
I ADELOED']"" W !,*7,"YOU MUST ENTER A LOCATION OF ENCOUNTER. ENTER ^L AT THE 'Select ADA CODE",!,"(or Action)' PROMPT TO EDIT LOCATION OF ENCOUNTER." D CON S Y=0 Q
I ADERDNMD']"" W !,*7,"YOU MUST ENTER AN ATTENDING DENTIST. ENTER ^D AT THE 'Select ADA CODE,",!,"(or Action)' PROMPT TO EDIT ATTENDING DENTIST." D CON S Y=0 Q
;/IHS/OIT/GAB 11.2014 Patch #26 Removed below line to add 2015 codes 9986 & 9987 (cancelled or missed appt.)
;I '$D(ADEV("0000")),'$D(ADEV("0190")),'$D(ADEV("9130")),'$D(ADEV("9140")) W !,*7,"You must enter a VISIT STATUS Code, either 0000, 0190, 9130, or 9140." D CON S Y=0 Q
;/IHS/OIT/GAB 11.2014 Patch #26 Added below line to change to 9986 & 9987 for 2015 code updates
I '$D(ADEV("0000")),'$D(ADEV("0190")),'$D(ADEV("9130")),'$D(ADEV("9140")),'$D(ADEV("9986")),'$D(ADEV("9987")) W !,*7,"You must enter a VISIT STATUS Code, either 0000, 0190, 9986, or 9987." D CON S Y=0 Q
;PROMPT FOR FINISH CONFIRMATION HERE
D HYGCHK
D CHK Q:'Y
S Y=1 Q
;
CHK W !!,"Ready to file this record" S %=2 D YN^DICN
I %Y["?" W !,?5,"Enter `Y' to save this visit permanently in the computer",!,?5,"Enter `N' to go back and continue editing the visit." G CHK
I %=1 S Y=1 Q
I %=2 S Y=0 Q
S Y=0 Q
;
HYGCHK ;
Q:ADEPVNM]""
N DIR,ADEFLG,ADEGRP,ADEJ
S ADEFLG=0 S ADEGRP=$O(^ADEDIT("GRP","B","HYG/THER DATA ENTRY CHECK",0)),ADEGRP=^ADEDIT("GRP",ADEGRP,1) D
. F ADEJ=1:1:$L(ADEGRP,"|") I $D(ADEV($P(ADEGRP,"|",ADEJ))) S ADEFLG=1 Q
Q:'ADEFLG
S DIR(0)="Y",DIR("A",1)="Some of the procedures entered are often performed by a HYGIENIST/THERAPIST."
S DIR("A")="Do you want to add a HYGIENIST/THERAPIST for this visit"
S DIR("B")="YES"
D ^DIR
I $$HAT^ADEGRL1()!(Y'=1)!(X[U) Q
D PROV^ADEGRL4
Q
K ADEGRP ;*NE
;
TFEE ;EP
W !,"TOTAL CHARGE THIS VISIT: ",$J(ADETCH,4,2),"// "
R X:DTIME
I X="" S Y=1 Q
I X["?" W !,"ENTER THE TOTAL CHARGE FOR THIS VISIT" G TFEE
I X["^" S Y=0 Q
S:X["$" X=$P(X,"$",2) I X'?.N.1".".2N!(X>9999)!(X<0) K X W *7," ??" G TFEE
S ADETCH=X,ADETCHF=1,Y=1 Q
CON R !,"(Press ENTER to continue) ",X:DTIME K X Q
FEE ;EP
W !,"FEE: "
S ADEDEF=$S($D(ADEV(ADECOD)):$P(ADEV(ADECOD),U,3),1:"") W:ADEDEF]"" ADEDEF,"// "
R ADEFEE:DTIME S:'$T ADEFEE="^"
S:ADEFEE="" ADEFEE=+ADEDEF
I ADEFEE["?" S ADEHOLD=Y(0),XQH="ADE-DVIS-CDV-FEES" D EN^XQH,LIST^ADEGRL3 W !,"ADA Code: ",ADECOD S Y(0)=ADEHOLD K ADEHOLD,XQH G FEE
I ADEFEE["^" S ADEY=0 Q
S:ADEFEE["$" ADEFEE=$P(ADEFEE,"$",2) I ADEFEE'?.N.1".".2N!(ADEFEE>9999)!(ADEFEE<0) K ADEFEE W *7," ??" G FEE
S $P(ADEV(ADECOD),U,3)=ADEFEE
Q
ADEGRL31 ; IHS/HQT/MJL - DENTAL ENTRY PART 5 ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;**26**;APRIL 1999;Build 13
+2 ;;IHS/OIT/GAB 10.2014 Modified for 2015 Code Updates - PATCH 26
DEL ;EP
+1 IF '$DATA(ADEV)
QUIT
DO LIST^ADEGRL3
D1 WRITE !!,"DELETE WHICH CODE? "
+1 READ X:DTIME
IF '$TEST
SET X="^"
+2 IF X=""!(X="^")
QUIT
+3 IF X["?"
WRITE !,?5,"ENTER AN ADA CODE FROM THE ABOVE LIST TO DELETE",!,?10,"OR PRESS 'RETURN' TO DELETE NOTHING"
GOTO D1
+4 IF '$DATA(ADEV(X))
WRITE *7,"??"
GOTO D1
+5 KILL ADEV(X),ADEDES(X)
+6 QUIT
EXIT ;EP
+1 IF (X="^Q")!(X="^")
SET ADENOUPD=1
SET Y=1
WRITE !!,?20,"***DATA ENTRY ABORTED***",*7
HANG 1
QUIT
+2 IF ADELOED']""
WRITE !,*7,"YOU MUST ENTER A LOCATION OF ENCOUNTER. ENTER ^L AT THE 'Select ADA CODE",!,"(or Action)' PROMPT TO EDIT LOCATION OF ENCOUNTER."
DO CON
SET Y=0
QUIT
+3 IF ADERDNMD']""
WRITE !,*7,"YOU MUST ENTER AN ATTENDING DENTIST. ENTER ^D AT THE 'Select ADA CODE,",!,"(or Action)' PROMPT TO EDIT ATTENDING DENTIST."
DO CON
SET Y=0
QUIT
+4 ;/IHS/OIT/GAB 11.2014 Patch #26 Removed below line to add 2015 codes 9986 & 9987 (cancelled or missed appt.)
+5 ;I '$D(ADEV("0000")),'$D(ADEV("0190")),'$D(ADEV("9130")),'$D(ADEV("9140")) W !,*7,"You must enter a VISIT STATUS Code, either 0000, 0190, 9130, or 9140." D CON S Y=0 Q
+6 ;/IHS/OIT/GAB 11.2014 Patch #26 Added below line to change to 9986 & 9987 for 2015 code updates
+7 IF '$DATA(ADEV("0000"))
IF '$DATA(ADEV("0190"))
IF '$DATA(ADEV("9130"))
IF '$DATA(ADEV("9140"))
IF '$DATA(ADEV("9986"))
IF '$DATA(ADEV("9987"))
WRITE !,*7,"You must enter a VISIT STATUS Code, either 0000, 0190, 9986, or 9987."
DO CON
SET Y=0
QUIT
+8 ;PROMPT FOR FINISH CONFIRMATION HERE
+9 DO HYGCHK
+10 DO CHK
IF 'Y
QUIT
+11 SET Y=1
QUIT
+12 ;
CHK WRITE !!,"Ready to file this record"
SET %=2
DO YN^DICN
+1 IF %Y["?"
WRITE !,?5,"Enter `Y' to save this visit permanently in the computer",!,?5,"Enter `N' to go back and continue editing the visit."
GOTO CHK
+2 IF %=1
SET Y=1
QUIT
+3 IF %=2
SET Y=0
QUIT
+4 SET Y=0
QUIT
+5 ;
HYGCHK ;
+1 IF ADEPVNM]""
QUIT
+2 NEW DIR,ADEFLG,ADEGRP,ADEJ
+3 SET ADEFLG=0
SET ADEGRP=$ORDER(^ADEDIT("GRP","B","HYG/THER DATA ENTRY CHECK",0))
SET ADEGRP=^ADEDIT("GRP",ADEGRP,1)
Begin DoDot:1
+4 FOR ADEJ=1:1:$LENGTH(ADEGRP,"|")
IF $DATA(ADEV($PIECE(ADEGRP,"|",ADEJ)))
SET ADEFLG=1
QUIT
End DoDot:1
+5 IF 'ADEFLG
QUIT
+6 SET DIR(0)="Y"
SET DIR("A",1)="Some of the procedures entered are often performed by a HYGIENIST/THERAPIST."
+7 SET DIR("A")="Do you want to add a HYGIENIST/THERAPIST for this visit"
+8 SET DIR("B")="YES"
+9 DO ^DIR
+10 IF $$HAT^ADEGRL1()!(Y'=1)!(X[U)
QUIT
+11 DO PROV^ADEGRL4
+12 QUIT
+13 ;*NE
KILL ADEGRP
+14 ;
TFEE ;EP
+1 WRITE !,"TOTAL CHARGE THIS VISIT: ",$JUSTIFY(ADETCH,4,2),"// "
+2 READ X:DTIME
+3 IF X=""
SET Y=1
QUIT
+4 IF X["?"
WRITE !,"ENTER THE TOTAL CHARGE FOR THIS VISIT"
GOTO TFEE
+5 IF X["^"
SET Y=0
QUIT
+6 IF X["$"
SET X=$PIECE(X,"$",2)
IF X'?.N.1".".2N!(X>9999)!(X<0)
KILL X
WRITE *7," ??"
GOTO TFEE
+7 SET ADETCH=X
SET ADETCHF=1
SET Y=1
QUIT
CON READ !,"(Press ENTER to continue) ",X:DTIME
KILL X
QUIT
FEE ;EP
+1 WRITE !,"FEE: "
+2 SET ADEDEF=$SELECT($DATA(ADEV(ADECOD)):$PIECE(ADEV(ADECOD),U,3),1:"")
IF ADEDEF]""
WRITE ADEDEF,"// "
+3 READ ADEFEE:DTIME
IF '$TEST
SET ADEFEE="^"
+4 IF ADEFEE=""
SET ADEFEE=+ADEDEF
+5 IF ADEFEE["?"
SET ADEHOLD=Y(0)
SET XQH="ADE-DVIS-CDV-FEES"
DO EN^XQH
DO LIST^ADEGRL3
WRITE !,"ADA Code: ",ADECOD
SET Y(0)=ADEHOLD
KILL ADEHOLD,XQH
GOTO FEE
+6 IF ADEFEE["^"
SET ADEY=0
QUIT
+7 IF ADEFEE["$"
SET ADEFEE=$PIECE(ADEFEE,"$",2)
IF ADEFEE'?.N.1".".2N!(ADEFEE>9999)!(ADEFEE<0)
KILL ADEFEE
WRITE *7," ??"
GOTO FEE
+8 SET $PIECE(ADEV(ADECOD),U,3)=ADEFEE
+9 QUIT
