DENTCPM1 ;Wash/HCD,JED-Dental CPM Help Processing ; 11/6/87 3:36 PM ;
;VERSION 1.2
;
HLP4 D H W !!,?10,"A. Zero to two teeth",!,?10,"B. Three to five teeth",!,?10,"C. Six teeth or more" S B="A,B,C" D DERD I X=""!(X="^") Q
S:X="A" DENTAPT=0 S:X="B" DENTAPT=1
I X["C" W !!,?10,"A. Heavy calculus",!,?10,"B. Nominal calculus" S B="A,B" D DERD S:X["A" DENTAPT=2 S:X["B" DENTAPT=1
G:DENTAPT="" HLP4 S DENTS=3 D DEAPPT Q
HLP6 D H W !!,?10,"A. Less than six teeth",!,?10,"B. Six teeth or more" S B="A,B" D DERD I X=""!(X="^") Q
I X["A" S DENTAPT=0,DENTS=5 D DEAPPT Q
HLP6A G:X'["B" HLP6 W !!,?10,"Is there a moderate, severe or acute periodontal condition" S %=1 D YN^DICN G HLP6A:%=0 I %=1 S DENTAPT=6,DENTS=5 D DEAPPT Q
W !!,?10,"A. Patient's Age 40 to 60 years old",!,?10,"B. Patient's age under 40 years old" S B="A,B" D DERD I X=""!(X="^") Q
I X["A" S DENTAPT=1,DENTS=5 D DEAPPT Q
W !!,?10,"Are there:",!!,?10,"A. Three or more sextants to receive C&B",!,?10,"B. Less than three sextants to receive C&B" S B="A,B" D DERD I X=""!(X="^") Q
I X["A" S DENTAPT=1,DENTS=5 D DEAPPT Q
HLP6B W !!,?10,"Is Gingivitis present" S %=1 D YN^DICN G HLP6B:%=0 S DENTAPT=$S(%=1:1,1:0),DENTS=5 D DEAPPT Q
HLP8 D H W !!,?10,"Enter the number (from 1 to 8) of anterior and",!,?10,"bicuspids to receive ENDODONTIC treatment" D DERD I X=""!(X="^") Q
I X'?.N!(X<1)!(X>8) W *7 G HLP8
S A=3 S:X>4 A=4 S:X=0 A=0 I X=1!(X=2) S A=2
HLP8A W !!,?10,"Enter the number (from 1 to 12) of molars to receive ENDO treatment" D DERD I X=""!(X="^") Q
I X'?.N!(X<1)!(X>12) W *7 G HLP8A
S DENTAPT=A+$S(X=0:0,X=1:2,X=2:3,1:4),DENTS=7 D DEAPPT Q
HLP10 D H W !!,?10,"Enter the number (from 1 to 6) of sextants to receive RESTORATIONS" D DERD I X=""!(X="^") Q
I X'?.N!(X<1)!(X>6) W *7 G HLP10
S:X<4 DENTAPT=X S:X>3 DENTAPT=X+1 S DENTS=9 D DEAPPT Q
HLP12 D H W !!,?10,"A. Extractions",!,?10,"B. Other Procedures",!,?10,"C. Extractions and other" S B="A,B,C" D DERD I X=""!(X="^") Q
G:"ABC"'[X HLP12 I X["B" S DENTAPT=2,DENTS=11 D DEAPPT Q
S A=0 S:X["C" A=2 W !!,?10,"A. 1 to 6 teeth to be extracted",!,?10,"B. 6 or more teeth to be extracted" S B="A,B" D DERD I X["A" S DENTAPT=A+1,DENTS=11 D DEAPPT Q
I X["B" S DENTAPT=A+2,DENTS=11 D DEAPPT Q
G HLP12
HLP14 D H W !!,?10,"Enter the number (from 1 to 6) of sextants to receive C&B" D DERD I X=""!(X="^") Q
I X'?.N!(X<1)!(X>6) W *7 G HLP14
S:X=0 DENTAPT=0 S:X>0 DENTAPT=X*3 S DENTS=13 D DEAPPT Q
HLP16 D H W !!,?10,"The patient is in need of:",!,?10,"A. A new removable prosthetic",!,?10,"B. A rebased prosthetic",!,?10,"C. No removable prosthetic" S B="A,B,C" D DERD I X=""!(X="^") Q
S:X["A" DENTAPT=0 S:X["B" DENTAPT=5 S:X["C" DENTAPT=2 G:DENTAPT="" HLP16
S DENTS=15 D DEAPPT Q
H W !!,?10,"Answering the following question will calculate the",!,?10,"number of appointments necessary for this category." Q
DEAPPT W !!,"With the information provided, ",DENTAPT," appointment"_$S(DENTAPT=1:" was",1:"s were")," calculated to be necessary.",! W:DENTAPT "This value has been entered.",!
S:DENTAPT $P(^DENT(220,D0,9,DA,0),"^",DENTS)=DENTAPT,DE(DQ)=DENTAPT K %,A,DENTS,X,DENTAPT Q
DERD S DENTAPT="" R !!,?10,"Enter your selection here: ",X:DTIME Q:X=""!(X="^") I X["?" D Q G DERD
I $D(B),B'[X W *7 D Q G DERD
K B Q
Q W !,?10,"Select ",B," or press return to exit this set of questions." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTCPM1 3356 printed Oct 16, 2024@17:46:57 Page 2
DENTCPM1 ;Wash/HCD,JED-Dental CPM Help Processing ; 11/6/87 3:36 PM ;
+1 ;VERSION 1.2
+2 ;
HLP4 DO H
WRITE !!,?10,"A. Zero to two teeth",!,?10,"B. Three to five teeth",!,?10,"C. Six teeth or more"
SET B="A,B,C"
DO DERD
IF X=""!(X="^")
QUIT
+1 if X="A"
SET DENTAPT=0
if X="B"
SET DENTAPT=1
+2 IF X["C"
WRITE !!,?10,"A. Heavy calculus",!,?10,"B. Nominal calculus"
SET B="A,B"
DO DERD
if X["A"
SET DENTAPT=2
if X["B"
SET DENTAPT=1
+3 if DENTAPT=""
GOTO HLP4
SET DENTS=3
DO DEAPPT
QUIT
HLP6 DO H
WRITE !!,?10,"A. Less than six teeth",!,?10,"B. Six teeth or more"
SET B="A,B"
DO DERD
IF X=""!(X="^")
QUIT
+1 IF X["A"
SET DENTAPT=0
SET DENTS=5
DO DEAPPT
QUIT
HLP6A if X'["B"
GOTO HLP6
WRITE !!,?10,"Is there a moderate, severe or acute periodontal condition"
SET %=1
DO YN^DICN
if %=0
GOTO HLP6A
IF %=1
SET DENTAPT=6
SET DENTS=5
DO DEAPPT
QUIT
+1 WRITE !!,?10,"A. Patient's Age 40 to 60 years old",!,?10,"B. Patient's age under 40 years old"
SET B="A,B"
DO DERD
IF X=""!(X="^")
QUIT
+2 IF X["A"
SET DENTAPT=1
SET DENTS=5
DO DEAPPT
QUIT
+3 WRITE !!,?10,"Are there:",!!,?10,"A. Three or more sextants to receive C&B",!,?10,"B. Less than three sextants to receive C&B"
SET B="A,B"
DO DERD
IF X=""!(X="^")
QUIT
+4 IF X["A"
SET DENTAPT=1
SET DENTS=5
DO DEAPPT
QUIT
HLP6B WRITE !!,?10,"Is Gingivitis present"
SET %=1
DO YN^DICN
if %=0
GOTO HLP6B
SET DENTAPT=$SELECT(%=1:1,1:0)
SET DENTS=5
DO DEAPPT
QUIT
HLP8 DO H
WRITE !!,?10,"Enter the number (from 1 to 8) of anterior and",!,?10,"bicuspids to receive ENDODONTIC treatment"
DO DERD
IF X=""!(X="^")
QUIT
+1 IF X'?.N!(X<1)!(X>8)
WRITE *7
GOTO HLP8
+2 SET A=3
if X>4
SET A=4
if X=0
SET A=0
IF X=1!(X=2)
SET A=2
HLP8A WRITE !!,?10,"Enter the number (from 1 to 12) of molars to receive ENDO treatment"
DO DERD
IF X=""!(X="^")
QUIT
+1 IF X'?.N!(X<1)!(X>12)
WRITE *7
GOTO HLP8A
+2 SET DENTAPT=A+$SELECT(X=0:0,X=1:2,X=2:3,1:4)
SET DENTS=7
DO DEAPPT
QUIT
HLP10 DO H
WRITE !!,?10,"Enter the number (from 1 to 6) of sextants to receive RESTORATIONS"
DO DERD
IF X=""!(X="^")
QUIT
+1 IF X'?.N!(X<1)!(X>6)
WRITE *7
GOTO HLP10
+2 if X<4
SET DENTAPT=X
if X>3
SET DENTAPT=X+1
SET DENTS=9
DO DEAPPT
QUIT
HLP12 DO H
WRITE !!,?10,"A. Extractions",!,?10,"B. Other Procedures",!,?10,"C. Extractions and other"
SET B="A,B,C"
DO DERD
IF X=""!(X="^")
QUIT
+1 if "ABC"'[X
GOTO HLP12
IF X["B"
SET DENTAPT=2
SET DENTS=11
DO DEAPPT
QUIT
+2 SET A=0
if X["C"
SET A=2
WRITE !!,?10,"A. 1 to 6 teeth to be extracted",!,?10,"B. 6 or more teeth to be extracted"
SET B="A,B"
DO DERD
IF X["A"
SET DENTAPT=A+1
SET DENTS=11
DO DEAPPT
QUIT
+3 IF X["B"
SET DENTAPT=A+2
SET DENTS=11
DO DEAPPT
QUIT
+4 GOTO HLP12
HLP14 DO H
WRITE !!,?10,"Enter the number (from 1 to 6) of sextants to receive C&B"
DO DERD
IF X=""!(X="^")
QUIT
+1 IF X'?.N!(X<1)!(X>6)
WRITE *7
GOTO HLP14
+2 if X=0
SET DENTAPT=0
if X>0
SET DENTAPT=X*3
SET DENTS=13
DO DEAPPT
QUIT
HLP16 DO H
WRITE !!,?10,"The patient is in need of:",!,?10,"A. A new removable prosthetic",!,?10,"B. A rebased prosthetic",!,?10,"C. No removable prosthetic"
SET B="A,B,C"
DO DERD
IF X=""!(X="^")
QUIT
+1 if X["A"
SET DENTAPT=0
if X["B"
SET DENTAPT=5
if X["C"
SET DENTAPT=2
if DENTAPT=""
GOTO HLP16
+2 SET DENTS=15
DO DEAPPT
QUIT
H WRITE !!,?10,"Answering the following question will calculate the",!,?10,"number of appointments necessary for this category."
QUIT
DEAPPT WRITE !!,"With the information provided, ",DENTAPT," appointment"_$SELECT(DENTAPT=1:" was",1:"s were")," calculated to be necessary.",!
if DENTAPT
WRITE "This value has been entered.",!
+1 if DENTAPT
SET $PIECE(^DENT(220,D0,9,DA,0),"^",DENTS)=DENTAPT
SET DE(DQ)=DENTAPT
KILL %,A,DENTS,X,DENTAPT
QUIT
DERD SET DENTAPT=""
READ !!,?10,"Enter your selection here: ",X:DTIME
if X=""!(X="^")
QUIT
IF X["?"
DO Q
GOTO DERD
+1 IF $DATA(B)
IF B'[X
WRITE *7
DO Q
GOTO DERD
+2 KILL B
QUIT
Q WRITE !,?10,"Select ",B," or press return to exit this set of questions."
QUIT
