- DENTAR3 ;ISC2/SAW,HAG-CLASS I-VI SERVICE REPORT RELEASE OPTION ; 3/13/89 10:46 AM ;
- ;VERSION 1.2
- S Y(0)=DENTY0,Z1="CLASS I TO VI (TYPE 3) REPORT FOR "_Z1,Z3="STATION NUMBER: "_Z2,DENTCD=$P(Y(0),"^",30),DENT=$S(DENTCD="C":8,DENTCD="D":"D",1:3)_DENTSTA_$E(DENT,4,5)_$E(DENT,6,7)_$E(DENT,2,3) F I=1:1:3 S (A(I),D(I),T(I))=""
- W @IOF,?(80-$L(Z1)/2),Z1,!,?(80-$L(Z3)/2),Z3
- W !!,?15,"TREATMENT",?32,"TREATMENT CASES",?53,"TREATMENT CASES"
- W !,?12,"CASES AUTHORIZED",?31,"PENDING INITIATION",?52,"PENDING COMPLETION"
- W !,"CLASS I",?18,$J($P(Y(0),U,2),3) S A(1)=$P(Y(0),U,2),L=2,A=1 D B W ?38,$J($P(Y(0),U,3),3) S A(2)=$P(Y(0),U,3),A=2 D B W ?59,$J($P(Y(0),U,4),3) S A(3)=$P(Y(0),U,4),A=3 D B
- W !,"CLASS II",?18,$J($P(Y(0),U,5),3) S A(1)=$P(Y(0),U,5),L=3,A=1 D B W ?38,$J($P(Y(0),U,6),3) S A(2)=$P(Y(0),U,6),A=2 D B W ?59,$J($P(Y(0),U,7),3) S A(3)=$P(Y(0),U,7),A=3 D B
- W !,"CLASS IIA",?18,$J($P(Y(0),U,8),3) S A(1)=$P(Y(0),U,8),L=2,A=1 D B W ?38,$J($P(Y(0),U,9),3) S A(2)=$P(Y(0),U,9),A=2 D B W ?59,$J($P(Y(0),U,10),3) S A(3)=$P(Y(0),U,10),A=3 D B
- W !,"CLASS IIB",?18,$J($P(Y(0),U,11),3) S A(1)=$P(Y(0),U,11),L=2,A=1 D B W ?38,$J($P(Y(0),U,12),3) S A(2)=$P(Y(0),U,12),A=2 D B W ?59,$J($P(Y(0),U,13),3) S A(3)=$P(Y(0),U,13),A=3 D B
- W !,"CLASS IIC",?18,$J($P(Y(0),U,14),3) S A(1)=$P(Y(0),U,14),L=2,A=1 D B W ?38,$J($P(Y(0),U,15),3) S A(2)=$P(Y(0),U,15),A=2 D B W ?59,$J($P(Y(0),U,16),3) S A(3)=$P(Y(0),U,16),A=3 D B
- W !,"CLASS III",?18,$J($P(Y(0),U,17),3) S A(1)=$P(Y(0),U,17),L=3,A=1 D B W ?38,$J($P(Y(0),U,18),3) S A(2)=$P(Y(0),U,18),A=2 D B W ?59,$J($P(Y(0),U,19),3) S A(3)=$P(Y(0),U,19),A=3 D B
- W !,"CLASS IV",?18,$J($P(Y(0),U,20),3) S A(1)=$P(Y(0),U,20),L=3,A=1 D B W ?38,$J($P(Y(0),U,21),3) S A(2)=$P(Y(0),U,21),A=2 D B W ?59,$J($P(Y(0),U,22),3) S A(3)=$P(Y(0),U,22),A=3 D B
- W !,"CLASS V",?18,$J($P(Y(0),U,23),3) S A(1)=$P(Y(0),U,23),L=2,A=1 D B W ?38,$J($P(Y(0),U,24),3) S A(2)=$P(Y(0),U,24),A=2 D B W ?59,$J($P(Y(0),U,25),3) S A(3)=$P(Y(0),U,25),A=3 D B
- W !,"CLASS VI",?18,$J($P(Y(0),U,26),3) S A(1)=$P(Y(0),U,26),L=2,A=1 D B W ?38,$J($P(Y(0),U,27),3) S A(2)=$P(Y(0),U,27),A=2 D B W ?59,$J($P(Y(0),U,28),3) S A(3)=$P(Y(0),U,28),A=3 D B
- W !!,?5,"TOTALS",?17,$J(T(1),4),?37,$J(T(2),4),?58,$J(T(3),4)
- F I=1:1:3 S DENT=DENT_D(I)
- K A,D,DENTCD,I,L,T,V,Y Q
- B S V="000"_A(A),D(A)=D(A)_$E(V,$L(V)-(L-1),$L(V)),T(A)=T(A)+A(A) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAR3 2352 printed Feb 18, 2025@23:12:23 Page 2
- DENTAR3 ;ISC2/SAW,HAG-CLASS I-VI SERVICE REPORT RELEASE OPTION ; 3/13/89 10:46 AM ;
- +1 ;VERSION 1.2
- +2 SET Y(0)=DENTY0
- SET Z1="CLASS I TO VI (TYPE 3) REPORT FOR "_Z1
- SET Z3="STATION NUMBER: "_Z2
- SET DENTCD=$PIECE(Y(0),"^",30)
- SET DENT=$SELECT(DENTCD="C":8,DENTCD="D":"D",1:3)_DENTSTA_$EXTRACT(DENT,4,5)_$EXTRACT(DENT,6,7)_$EXTRACT(DENT,2,3)
- FOR I=1:1:3
- SET (A(I),D(I),T(I))=""
- +3 WRITE @IOF,?(80-$LENGTH(Z1)/2),Z1,!,?(80-$LENGTH(Z3)/2),Z3
- +4 WRITE !!,?15,"TREATMENT",?32,"TREATMENT CASES",?53,"TREATMENT CASES"
- +5 WRITE !,?12,"CASES AUTHORIZED",?31,"PENDING INITIATION",?52,"PENDING COMPLETION"
- +6 WRITE !,"CLASS I",?18,$JUSTIFY($PIECE(Y(0),U,2),3)
- SET A(1)=$PIECE(Y(0),U,2)
- SET L=2
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,3),3)
- SET A(2)=$PIECE(Y(0),U,3)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,4),3)
- SET A(3)=$PIECE(Y(0),U,4)
- SET A=3
- DO B
- +7 WRITE !,"CLASS II",?18,$JUSTIFY($PIECE(Y(0),U,5),3)
- SET A(1)=$PIECE(Y(0),U,5)
- SET L=3
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,6),3)
- SET A(2)=$PIECE(Y(0),U,6)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,7),3)
- SET A(3)=$PIECE(Y(0),U,7)
- SET A=3
- DO B
- +8 WRITE !,"CLASS IIA",?18,$JUSTIFY($PIECE(Y(0),U,8),3)
- SET A(1)=$PIECE(Y(0),U,8)
- SET L=2
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,9),3)
- SET A(2)=$PIECE(Y(0),U,9)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,10),3)
- SET A(3)=$PIECE(Y(0),U,10)
- SET A=3
- DO B
- +9 WRITE !,"CLASS IIB",?18,$JUSTIFY($PIECE(Y(0),U,11),3)
- SET A(1)=$PIECE(Y(0),U,11)
- SET L=2
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,12),3)
- SET A(2)=$PIECE(Y(0),U,12)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,13),3)
- SET A(3)=$PIECE(Y(0),U,13)
- SET A=3
- DO B
- +10 WRITE !,"CLASS IIC",?18,$JUSTIFY($PIECE(Y(0),U,14),3)
- SET A(1)=$PIECE(Y(0),U,14)
- SET L=2
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,15),3)
- SET A(2)=$PIECE(Y(0),U,15)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,16),3)
- SET A(3)=$PIECE(Y(0),U,16)
- SET A=3
- DO B
- +11 WRITE !,"CLASS III",?18,$JUSTIFY($PIECE(Y(0),U,17),3)
- SET A(1)=$PIECE(Y(0),U,17)
- SET L=3
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,18),3)
- SET A(2)=$PIECE(Y(0),U,18)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,19),3)
- SET A(3)=$PIECE(Y(0),U,19)
- SET A=3
- DO B
- +12 WRITE !,"CLASS IV",?18,$JUSTIFY($PIECE(Y(0),U,20),3)
- SET A(1)=$PIECE(Y(0),U,20)
- SET L=3
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,21),3)
- SET A(2)=$PIECE(Y(0),U,21)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,22),3)
- SET A(3)=$PIECE(Y(0),U,22)
- SET A=3
- DO B
- +13 WRITE !,"CLASS V",?18,$JUSTIFY($PIECE(Y(0),U,23),3)
- SET A(1)=$PIECE(Y(0),U,23)
- SET L=2
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,24),3)
- SET A(2)=$PIECE(Y(0),U,24)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,25),3)
- SET A(3)=$PIECE(Y(0),U,25)
- SET A=3
- DO B
- +14 WRITE !,"CLASS VI",?18,$JUSTIFY($PIECE(Y(0),U,26),3)
- SET A(1)=$PIECE(Y(0),U,26)
- SET L=2
- SET A=1
- DO B
- WRITE ?38,$JUSTIFY($PIECE(Y(0),U,27),3)
- SET A(2)=$PIECE(Y(0),U,27)
- SET A=2
- DO B
- WRITE ?59,$JUSTIFY($PIECE(Y(0),U,28),3)
- SET A(3)=$PIECE(Y(0),U,28)
- SET A=3
- DO B
- +15 WRITE !!,?5,"TOTALS",?17,$JUSTIFY(T(1),4),?37,$JUSTIFY(T(2),4),?58,$JUSTIFY(T(3),4)
- +16 FOR I=1:1:3
- SET DENT=DENT_D(I)
- +17 KILL A,D,DENTCD,I,L,T,V,Y
- QUIT
- B SET V="000"_A(A)
- SET D(A)=D(A)_$EXTRACT(V,$LENGTH(V)-(L-1),$LENGTH(V))
- SET T(A)=T(A)+A(A)
- QUIT