source: FOIAVistA/trunk/r/DENTAL-DEN/DENTCPM1.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1DENTCPM1 ;Wash/HCD,JED-Dental CPM Help Processing ; 11/6/87 3:36 PM ;
2 ;VERSION 1.2
3 ;
4HLP4 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
5 S:X="A" DENTAPT=0 S:X="B" DENTAPT=1
6 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
7 G:DENTAPT="" HLP4 S DENTS=3 D DEAPPT Q
8HLP6 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
9 I X["A" S DENTAPT=0,DENTS=5 D DEAPPT Q
10HLP6A 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
11 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
12 I X["A" S DENTAPT=1,DENTS=5 D DEAPPT Q
13 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
14 I X["A" S DENTAPT=1,DENTS=5 D DEAPPT Q
15HLP6B 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
16HLP8 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
17 I X'?.N!(X<1)!(X>8) W *7 G HLP8
18 S A=3 S:X>4 A=4 S:X=0 A=0 I X=1!(X=2) S A=2
19HLP8A W !!,?10,"Enter the number (from 1 to 12) of molars to receive ENDO treatment" D DERD I X=""!(X="^") Q
20 I X'?.N!(X<1)!(X>12) W *7 G HLP8A
21 S DENTAPT=A+$S(X=0:0,X=1:2,X=2:3,1:4),DENTS=7 D DEAPPT Q
22HLP10 D H W !!,?10,"Enter the number (from 1 to 6) of sextants to receive RESTORATIONS" D DERD I X=""!(X="^") Q
23 I X'?.N!(X<1)!(X>6) W *7 G HLP10
24 S:X<4 DENTAPT=X S:X>3 DENTAPT=X+1 S DENTS=9 D DEAPPT Q
25HLP12 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
26 G:"ABC"'[X HLP12 I X["B" S DENTAPT=2,DENTS=11 D DEAPPT Q
27 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
28 I X["B" S DENTAPT=A+2,DENTS=11 D DEAPPT Q
29 G HLP12
30HLP14 D H W !!,?10,"Enter the number (from 1 to 6) of sextants to receive C&B" D DERD I X=""!(X="^") Q
31 I X'?.N!(X<1)!(X>6) W *7 G HLP14
32 S:X=0 DENTAPT=0 S:X>0 DENTAPT=X*3 S DENTS=13 D DEAPPT Q
33HLP16 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
34 S:X["A" DENTAPT=0 S:X["B" DENTAPT=5 S:X["C" DENTAPT=2 G:DENTAPT="" HLP16
35 S DENTS=15 D DEAPPT Q
36H W !!,?10,"Answering the following question will calculate the",!,?10,"number of appointments necessary for this category." Q
37DEAPPT 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.",!
38 S:DENTAPT $P(^DENT(220,D0,9,DA,0),"^",DENTS)=DENTAPT,DE(DQ)=DENTAPT K %,A,DENTS,X,DENTAPT Q
39DERD S DENTAPT="" R !!,?10,"Enter your selection here: ",X:DTIME Q:X=""!(X="^") I X["?" D Q G DERD
40 I $D(B),B'[X W *7 D Q G DERD
41 K B Q
42Q W !,?10,"Select ",B," or press return to exit this set of questions." Q
Note: See TracBrowser for help on using the repository browser.