DENTAR5 ;ISC2/SAW,HAG-FEE BASIS SERVICE REPORT RELEASE OPTION ; 3/22/89 11:33 AM ;
;VERSION 1.2
S Y(0)=DENTY0,Z1="FEE BASIS (TYPE 5) REPORT FOR "_Z1,Z3="STATION NUMBER: "_Z2,DENTCD=$P(Y(0),"^",29),DENT=$S(DENTCD="C":"A",DENTCD="D":"F",1:5)_DENTSTA_$E(DENT,4,5)_$E(DENT,6,7)_$E(DENT,2,3)
W @IOF,?(80-$L(Z1)/2),Z1,!,?(80-$L(Z3)/2),Z3
W !!,"TOTAL APPLICATIONS RECEIVED",?33,":",$J($P(Y(0),U,2),4) S L=3,P=1,V=$P(Y(0),U,2) D B W ?45,"FEE CASES COMP CLASS I",?71,":",$J($P(Y(0),U,14),5) S L=2,P=13,V=$P(Y(0),U,14) D B
W !,"CLASS II APPLICATIONS RECEIVED",?33,":",$J($P(Y(0),U,3),4) S L=3,P=2,V=$P(Y(0),U,3) D B W ?45,"FEE CASES COMP CLASS II",?71,":",$J($P(Y(0),U,15),5) S L=3,P=14,V=$P(Y(0),U,15) D B
W !,"TOT APP DETERM ELIG FOR EXAM",?33,":",$J($P(Y(0),U,4),4) S L=3,P=3,V=$P(Y(0),U,4) D B W ?45,"FEE CASES COMP CLASS IIA",?71,":",$J($P(Y(0),U,16),5) S L=2,P=15,V=$P(Y(0),U,16) D B
W !,"TOT APP PEND DETERM OF ELIG EXAM",?33,":",$J($P(Y(0),U,5),4) S L=3,P=4,V=$P(Y(0),U,5) D B W ?45,"FEE CASES COMP CLASS IIB",?71,":",$J($P(Y(0),U,17),5) S L=2,P=16,V=$P(Y(0),U,17) D B
W !,"TOTAL EXAM AUTH TO BE DONE BY VA",?33,":",$J($P(Y(0),U,6),4) S L=3,P=5,V=$P(Y(0),U,6) D B W ?45,"FEE CASES COMP CLASS IIC",?71,":",$J($P(Y(0),U,18),5) S L=2,P=17,V=$P(Y(0),U,18) D B
W !,"TOTAL FEE AUTHORIZED EXAMS",?33,":",$J($P(Y(0),U,7),4) S L=3,P=6,V=$P(Y(0),U,7) D B W ?45,"FEE CASES COMP CLASS III",?71,":",$J($P(Y(0),U,19),5) S L=3,P=18,V=$P(Y(0),U,19) D B
W !,"TOT FEE EXAMS PENDING COMPLETION",?33,":",$J($P(Y(0),U,8),4) S L=3,P=7,V=$P(Y(0),U,8) D B W ?45,"FEE CASES COMP CLASS IV",?71,":",$J($P(Y(0),U,20),5) S L=3,P=19,V=$P(Y(0),U,20) D B
W !,"TOTAL FEE EXAMS COMPLETED",?33,":",$J($P(Y(0),U,9),4) S L=3,P=8,V=$P(Y(0),U,9) D B W ?45,"FEE CASES COMP CLASS V",?71,":",$J($P(Y(0),U,21),5) S L=2,P=20,V=$P(Y(0),U,21) D B
W !,"TOT FEE TREAT PEND AUTHORIZATION",?33,":",$J($P(Y(0),U,10),4) S L=3,P=9,V=$P(Y(0),U,10) D B W ?45,"FEE CASES COMP CLASS VI",?71,":",$J($P(Y(0),U,22),5) S L=2,P=21,V=$P(Y(0),U,22) D B
W !,"TOTAL FEE TREATMENT AUTHORIZED",?33,":",$J($P(Y(0),U,11),4) S L=3,P=10,V=$P(Y(0),U,11) D B W ?45,"FEE AVG COST ALL CLASSES",?71,":",$J($P(Y(0),U,27),5) S L=4,P=22,V=$P(Y(0),U,27) D B
W !,"TOT FEE TREAT PEND COMPLETION",?33,":",$J($P(Y(0),U,12),4) S L=3,P=11,V=$P(Y(0),U,12) D B
W !,"TOTAL FEE TREATMENT COMPLETED",?33,":",$J($P(Y(0),U,13),4) S L=3,P=12,V=$P(Y(0),U,13) D B
F I=1:1:22 S DENT=DENT_D(I)
K D,DENTCD,DIC,I,L,P,V,Y Q
B S V="0000"_V,D(P)=$E(V,$L(V)-(L-1),$L(V)) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTAR5 2503 printed Oct 16, 2024@17:46:53 Page 2
DENTAR5 ;ISC2/SAW,HAG-FEE BASIS SERVICE REPORT RELEASE OPTION ; 3/22/89 11:33 AM ;
+1 ;VERSION 1.2
+2 SET Y(0)=DENTY0
SET Z1="FEE BASIS (TYPE 5) REPORT FOR "_Z1
SET Z3="STATION NUMBER: "_Z2
SET DENTCD=$PIECE(Y(0),"^",29)
SET DENT=$SELECT(DENTCD="C":"A",DENTCD="D":"F",1:5)_DENTSTA_$EXTRACT(DENT,4,5)_$EXTRACT(DENT,6,7)_$EXTRACT(DENT,2,3)
+3 WRITE @IOF,?(80-$LENGTH(Z1)/2),Z1,!,?(80-$LENGTH(Z3)/2),Z3
+4 WRITE !!,"TOTAL APPLICATIONS RECEIVED",?33,":",$JUSTIFY($PIECE(Y(0),U,2),4)
SET L=3
SET P=1
SET V=$PIECE(Y(0),U,2)
DO B
WRITE ?45,"FEE CASES COMP CLASS I",?71,":",$JUSTIFY($PIECE(Y(0),U,14),5)
SET L=2
SET P=13
SET V=$PIECE(Y(0),U,14)
DO B
+5 WRITE !,"CLASS II APPLICATIONS RECEIVED",?33,":",$JUSTIFY($PIECE(Y(0),U,3),4)
SET L=3
SET P=2
SET V=$PIECE(Y(0),U,3)
DO B
WRITE ?45,"FEE CASES COMP CLASS II",?71,":",$JUSTIFY($PIECE(Y(0),U,15),5)
SET L=3
SET P=14
SET V=$PIECE(Y(0),U,15)
DO B
+6 WRITE !,"TOT APP DETERM ELIG FOR EXAM",?33,":",$JUSTIFY($PIECE(Y(0),U,4),4)
SET L=3
SET P=3
SET V=$PIECE(Y(0),U,4)
DO B
WRITE ?45,"FEE CASES COMP CLASS IIA",?71,":",$JUSTIFY($PIECE(Y(0),U,16),5)
SET L=2
SET P=15
SET V=$PIECE(Y(0),U,16)
DO B
+7 WRITE !,"TOT APP PEND DETERM OF ELIG EXAM",?33,":",$JUSTIFY($PIECE(Y(0),U,5),4)
SET L=3
SET P=4
SET V=$PIECE(Y(0),U,5)
DO B
WRITE ?45,"FEE CASES COMP CLASS IIB",?71,":",$JUSTIFY($PIECE(Y(0),U,17),5)
SET L=2
SET P=16
SET V=$PIECE(Y(0),U,17)
DO B
+8 WRITE !,"TOTAL EXAM AUTH TO BE DONE BY VA",?33,":",$JUSTIFY($PIECE(Y(0),U,6),4)
SET L=3
SET P=5
SET V=$PIECE(Y(0),U,6)
DO B
WRITE ?45,"FEE CASES COMP CLASS IIC",?71,":",$JUSTIFY($PIECE(Y(0),U,18),5)
SET L=2
SET P=17
SET V=$PIECE(Y(0),U,18)
DO B
+9 WRITE !,"TOTAL FEE AUTHORIZED EXAMS",?33,":",$JUSTIFY($PIECE(Y(0),U,7),4)
SET L=3
SET P=6
SET V=$PIECE(Y(0),U,7)
DO B
WRITE ?45,"FEE CASES COMP CLASS III",?71,":",$JUSTIFY($PIECE(Y(0),U,19),5)
SET L=3
SET P=18
SET V=$PIECE(Y(0),U,19)
DO B
+10 WRITE !,"TOT FEE EXAMS PENDING COMPLETION",?33,":",$JUSTIFY($PIECE(Y(0),U,8),4)
SET L=3
SET P=7
SET V=$PIECE(Y(0),U,8)
DO B
WRITE ?45,"FEE CASES COMP CLASS IV",?71,":",$JUSTIFY($PIECE(Y(0),U,20),5)
SET L=3
SET P=19
SET V=$PIECE(Y(0),U,20)
DO B
+11 WRITE !,"TOTAL FEE EXAMS COMPLETED",?33,":",$JUSTIFY($PIECE(Y(0),U,9),4)
SET L=3
SET P=8
SET V=$PIECE(Y(0),U,9)
DO B
WRITE ?45,"FEE CASES COMP CLASS V",?71,":",$JUSTIFY($PIECE(Y(0),U,21),5)
SET L=2
SET P=20
SET V=$PIECE(Y(0),U,21)
DO B
+12 WRITE !,"TOT FEE TREAT PEND AUTHORIZATION",?33,":",$JUSTIFY($PIECE(Y(0),U,10),4)
SET L=3
SET P=9
SET V=$PIECE(Y(0),U,10)
DO B
WRITE ?45,"FEE CASES COMP CLASS VI",?71,":",$JUSTIFY($PIECE(Y(0),U,22),5)
SET L=2
SET P=21
SET V=$PIECE(Y(0),U,22)
DO B
+13 WRITE !,"TOTAL FEE TREATMENT AUTHORIZED",?33,":",$JUSTIFY($PIECE(Y(0),U,11),4)
SET L=3
SET P=10
SET V=$PIECE(Y(0),U,11)
DO B
WRITE ?45,"FEE AVG COST ALL CLASSES",?71,":",$JUSTIFY($PIECE(Y(0),U,27),5)
SET L=4
SET P=22
SET V=$PIECE(Y(0),U,27)
DO B
+14 WRITE !,"TOT FEE TREAT PEND COMPLETION",?33,":",$JUSTIFY($PIECE(Y(0),U,12),4)
SET L=3
SET P=11
SET V=$PIECE(Y(0),U,12)
DO B
+15 WRITE !,"TOTAL FEE TREATMENT COMPLETED",?33,":",$JUSTIFY($PIECE(Y(0),U,13),4)
SET L=3
SET P=12
SET V=$PIECE(Y(0),U,13)
DO B
+16 FOR I=1:1:22
SET DENT=DENT_D(I)
+17 KILL D,DENTCD,DIC,I,L,P,V,Y
QUIT
B SET V="0000"_V
SET D(P)=$EXTRACT(V,$LENGTH(V)-(L-1),$LENGTH(V))
QUIT
