- 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
