DENTPCD1 ;ISC2/SAW,HAG-PRINT CDR WORKSHEETS ;9/24/99 09:04
;;1.2;DENTAL;**4,24,29**;JAN 26, 1989
F I=1:1:18 S B(I)=B(I)/B,V=B(I) S:I=18 B(I)=V-F,V=B(I) S $P(B(I),"^",2)=V*R,X1=V*R,$P(B(I),"^",3)=V*E,X2=V*E,$P(B(I),"^",4)=$P(B(I),"^")-(X1+X2)
A S DATE="FOR THE MONTH OF "_DT2_" "_(1700+$E(DATE,1,3)),T="Medical",K=1100,(RT,ST,M,N,S,P,C)=0 D EN3
W !,?5,T,!,?5,"01",?15,"1110.248",?27,"Medical",?55,$J($P(B(1),"^",4),7,4) S Z=1 D EN6
W !,?5,"06",?15,"1111.248",?27,"Neurology",?55,$J($P(B(6),"^",4),7,4) S Z=6 D EN6
W !,?5,"07",?15,"1113.248",?27,"Rehabilitation",?55,$J($P(B(7),"^",4),7,4) S Z=7 D EN6
W !,?5,"10",?15,"1116.248",?27,"Spinal Cord Injury",?55,$J($P(B(10),"^",4),7,4) S Z=10 D EN6
W !,?5,"11",?15,"1114.248",?27,"Epilepsy Center",?55,$J($P(B(11),"^",4),7,4) S Z=11 D EN6
W !,?5,"12",?15,"1115.248",?27,"Blind Rehabilitation",?55,$J($P(B(12),"^",4),7,4) S Z=12 D EN6
W !,?5,"13",?15,"1118.248",?27,"Dialysis Program",?55,$J($P(B(13),"^",4),7,4) S Z=13 D EN6
W !,?5,"14",?15,"1117.248",?27,"Medical Int. Care Unit",?55,$J($P(B(14),"^",4),7,4) S Z=14 D EN6,EN5
S T="Surgical",K=1200,(ST,M,N,S)=0
W !,?5,T,!,?5,"02",?15,"1210.248",?27,"Surgical",?55,$J($P(B(2),"^",4),7,4) S Z=2 D EN6
W !,?5,"15",?15,"1211.248",?27,"Surgical Int. Care Unit",?55,$J($P(B(15),"^",4),7,4) S Z=15 D EN6,EN5
S T="Psychiatry",K=1300,(ST,M,N,S)=0
W !,?5,T,!,?5,"03",?15,"1310.248",?27,"Psychiatry - Acute",?55,$J($P(B(3),"^",4),7,4) S Z=3 D EN6
W !,?5,"04",?15,"1310.248",?27,"Psychiatry - Long Term",?55,$J($P(B(4),"^",4),7,4) S Z=4 D EN6
W !,?5,"08",?15,"1313.248",?27,"Alcohol",?55,$J($P(B(8),"^",4),7,4) S Z=8 D EN6
W !,?5,"09",?15,"1313.248",?27,"Drug",?55,$J($P(B(9),"^",4),7,4) S Z=9 D EN6,EN5
S T="Nursing Home",K=1400,(ST,M,N,S)=0
W !,?5,T,!,?15,"1410.248",?27,"Nursing Home Care Unit",?55,$J($P(B(16),"^",4),7,4) S Z=16 D EN6,EN5
S T="Domiciliary",K=1500,(ST,M,N,S)=0 D EN3
W !,?5,T,!,?15,"1510.248",?27,"Domicilliary",?55,$J($P(B(17),"^",4),7,4) S Z=17 D EN6,EN5
S T="Intermediate Care",K=1600,(ST,M,N,S)=0
W !,?5,T,!,?5,"05",?15,"1610.248",?27,"Intermediate Care Activity",?55,$J($P(B(5),"^",4),7,4) S Z=5 D EN6,EN5
S T="Outpatient",K=2800,(ST,M,N,S)=0
W !,?5,T,!,?15,"2710.248",?27,"Outpatient",?55,$J($P(B(18),"^",4),7,4) S Z=18 D EN6,EN5
S T="*** CLINICAL---TOTAL ***"
W !,?5,T,?55,$J(P,7,4),!,?5,I,! S T="Non-Clinical Activity" W !,?5,T,!,?15,"4710.248",?27,"Dental Fee Basis",?55,$J(F,7,4)
S RT=RT+F+P W !,?5,I,!!,?5,"**** Reconciled --- Total ****",?55,$J(RT,7,4),! S I="",$P(I,"-",59)="" W ?5,I,!
W !,?5,"Disregard the following trainee data if your station does",!,?5,"not have a Dental Resident Program",!
S P=0 F I=1,6,7,10:1:14 S P=P+$P(B(I),"^")
W !,?15,"1100.11",?27,"Medical Bed Proportion",?55,$J(P,7,4)
S P=0 F I=2,15 S P=P+$P(B(I),"^")
W !,?15,"1200.11",?27,"Surgical Bed Proportion",?55,$J(P,7,4)
S P=0 F I=3,4,8,9 S P=P+$P(B(I),"^")
W !,?15,"1300.11",?27,"Psychiatry Bed Proportion",?55,$J(P,7,4)
W !,?15,"1400.11",?27,"Nursing Home Proportion",?55,$J($P(B(16),"^"),7,4)
W !,?15,"1500.11",?27,"Domicilliary Bed Proportion",?55,$J($P(B(17),"^"),7,4)
W !,?15,"1600.11",?27,"Intermediate Bed Proportion",?55,$J($P(B(5),"^"),7,4)
W !,?15,"2800.11",?27,"Outpatient Bed Proportion",?55,$J($P(B(18),"^"),7,4) Q
EN3 S C=C+1 W @IOF,!,?57,"Page ",C,!,?5,"MONTHLY DENTAL SERVICE COST DISTRIBUTION (10-0141) REPORT",!,?(68-$L(DATE)\2),DATE,!!,?5,"BED",?15,"ACCOUNT",!,?5,"SECTION",?15,"NUMBER",?27,"NAME",?55,"CLINICAL",! Q
EN5 S P=P+ST,Q=T_" Sub-Total" W !!,?(50-$L(Q)),Q,?55,$J(ST,7,4),!
W !,?16,K_".12",?27,"Instructional",?55,$J(M*P1,7,4) S RT=RT+(M*P1)
W !,?16,K_".13",?27,"Administrative",?55,$J(M*P2,7,4) S RT=RT+(M*P2)
W !,?16,K_".14",?27,"Continuing Education",?55,$J(M*P3,7,4) S RT=RT+(M*P3)
W !,?16,K_".21",?27,"Research",?55,$J(N,7,4),! S RT=RT+N,I="",$P(I,"-",59)="" W ?5,I,! Q
Q
EN6 S M=M+$P(B(Z),"^",3),N=N+$P(B(Z),"^",2),ST=ST+$P(B(Z),"^",4) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTPCD1 3960 printed Sep 23, 2025@19:22:41 Page 2
DENTPCD1 ;ISC2/SAW,HAG-PRINT CDR WORKSHEETS ;9/24/99 09:04
+1 ;;1.2;DENTAL;**4,24,29**;JAN 26, 1989
+2 FOR I=1:1:18
SET B(I)=B(I)/B
SET V=B(I)
if I=18
SET B(I)=V-F
SET V=B(I)
SET $PIECE(B(I),"^",2)=V*R
SET X1=V*R
SET $PIECE(B(I),"^",3)=V*E
SET X2=V*E
SET $PIECE(B(I),"^",4)=$PIECE(B(I),"^")-(X1+X2)
A SET DATE="FOR THE MONTH OF "_DT2_" "_(1700+$EXTRACT(DATE,1,3))
SET T="Medical"
SET K=1100
SET (RT,ST,M,N,S,P,C)=0
DO EN3
+1 WRITE !,?5,T,!,?5,"01",?15,"1110.248",?27,"Medical",?55,$JUSTIFY($PIECE(B(1),"^",4),7,4)
SET Z=1
DO EN6
+2 WRITE !,?5,"06",?15,"1111.248",?27,"Neurology",?55,$JUSTIFY($PIECE(B(6),"^",4),7,4)
SET Z=6
DO EN6
+3 WRITE !,?5,"07",?15,"1113.248",?27,"Rehabilitation",?55,$JUSTIFY($PIECE(B(7),"^",4),7,4)
SET Z=7
DO EN6
+4 WRITE !,?5,"10",?15,"1116.248",?27,"Spinal Cord Injury",?55,$JUSTIFY($PIECE(B(10),"^",4),7,4)
SET Z=10
DO EN6
+5 WRITE !,?5,"11",?15,"1114.248",?27,"Epilepsy Center",?55,$JUSTIFY($PIECE(B(11),"^",4),7,4)
SET Z=11
DO EN6
+6 WRITE !,?5,"12",?15,"1115.248",?27,"Blind Rehabilitation",?55,$JUSTIFY($PIECE(B(12),"^",4),7,4)
SET Z=12
DO EN6
+7 WRITE !,?5,"13",?15,"1118.248",?27,"Dialysis Program",?55,$JUSTIFY($PIECE(B(13),"^",4),7,4)
SET Z=13
DO EN6
+8 WRITE !,?5,"14",?15,"1117.248",?27,"Medical Int. Care Unit",?55,$JUSTIFY($PIECE(B(14),"^",4),7,4)
SET Z=14
DO EN6
DO EN5
+9 SET T="Surgical"
SET K=1200
SET (ST,M,N,S)=0
+10 WRITE !,?5,T,!,?5,"02",?15,"1210.248",?27,"Surgical",?55,$JUSTIFY($PIECE(B(2),"^",4),7,4)
SET Z=2
DO EN6
+11 WRITE !,?5,"15",?15,"1211.248",?27,"Surgical Int. Care Unit",?55,$JUSTIFY($PIECE(B(15),"^",4),7,4)
SET Z=15
DO EN6
DO EN5
+12 SET T="Psychiatry"
SET K=1300
SET (ST,M,N,S)=0
+13 WRITE !,?5,T,!,?5,"03",?15,"1310.248",?27,"Psychiatry - Acute",?55,$JUSTIFY($PIECE(B(3),"^",4),7,4)
SET Z=3
DO EN6
+14 WRITE !,?5,"04",?15,"1310.248",?27,"Psychiatry - Long Term",?55,$JUSTIFY($PIECE(B(4),"^",4),7,4)
SET Z=4
DO EN6
+15 WRITE !,?5,"08",?15,"1313.248",?27,"Alcohol",?55,$JUSTIFY($PIECE(B(8),"^",4),7,4)
SET Z=8
DO EN6
+16 WRITE !,?5,"09",?15,"1313.248",?27,"Drug",?55,$JUSTIFY($PIECE(B(9),"^",4),7,4)
SET Z=9
DO EN6
DO EN5
+17 SET T="Nursing Home"
SET K=1400
SET (ST,M,N,S)=0
+18 WRITE !,?5,T,!,?15,"1410.248",?27,"Nursing Home Care Unit",?55,$JUSTIFY($PIECE(B(16),"^",4),7,4)
SET Z=16
DO EN6
DO EN5
+19 SET T="Domiciliary"
SET K=1500
SET (ST,M,N,S)=0
DO EN3
+20 WRITE !,?5,T,!,?15,"1510.248",?27,"Domicilliary",?55,$JUSTIFY($PIECE(B(17),"^",4),7,4)
SET Z=17
DO EN6
DO EN5
+21 SET T="Intermediate Care"
SET K=1600
SET (ST,M,N,S)=0
+22 WRITE !,?5,T,!,?5,"05",?15,"1610.248",?27,"Intermediate Care Activity",?55,$JUSTIFY($PIECE(B(5),"^",4),7,4)
SET Z=5
DO EN6
DO EN5
+23 SET T="Outpatient"
SET K=2800
SET (ST,M,N,S)=0
+24 WRITE !,?5,T,!,?15,"2710.248",?27,"Outpatient",?55,$JUSTIFY($PIECE(B(18),"^",4),7,4)
SET Z=18
DO EN6
DO EN5
+25 SET T="*** CLINICAL---TOTAL ***"
+26 WRITE !,?5,T,?55,$JUSTIFY(P,7,4),!,?5,I,!
SET T="Non-Clinical Activity"
WRITE !,?5,T,!,?15,"4710.248",?27,"Dental Fee Basis",?55,$JUSTIFY(F,7,4)
+27 SET RT=RT+F+P
WRITE !,?5,I,!!,?5,"**** Reconciled --- Total ****",?55,$JUSTIFY(RT,7,4),!
SET I=""
SET $PIECE(I,"-",59)=""
WRITE ?5,I,!
+28 WRITE !,?5,"Disregard the following trainee data if your station does",!,?5,"not have a Dental Resident Program",!
+29 SET P=0
FOR I=1,6,7,10:1:14
SET P=P+$PIECE(B(I),"^")
+30 WRITE !,?15,"1100.11",?27,"Medical Bed Proportion",?55,$JUSTIFY(P,7,4)
+31 SET P=0
FOR I=2,15
SET P=P+$PIECE(B(I),"^")
+32 WRITE !,?15,"1200.11",?27,"Surgical Bed Proportion",?55,$JUSTIFY(P,7,4)
+33 SET P=0
FOR I=3,4,8,9
SET P=P+$PIECE(B(I),"^")
+34 WRITE !,?15,"1300.11",?27,"Psychiatry Bed Proportion",?55,$JUSTIFY(P,7,4)
+35 WRITE !,?15,"1400.11",?27,"Nursing Home Proportion",?55,$JUSTIFY($PIECE(B(16),"^"),7,4)
+36 WRITE !,?15,"1500.11",?27,"Domicilliary Bed Proportion",?55,$JUSTIFY($PIECE(B(17),"^"),7,4)
+37 WRITE !,?15,"1600.11",?27,"Intermediate Bed Proportion",?55,$JUSTIFY($PIECE(B(5),"^"),7,4)
+38 WRITE !,?15,"2800.11",?27,"Outpatient Bed Proportion",?55,$JUSTIFY($PIECE(B(18),"^"),7,4)
QUIT
EN3 SET C=C+1
WRITE @IOF,!,?57,"Page ",C,!,?5,"MONTHLY DENTAL SERVICE COST DISTRIBUTION (10-0141) REPORT",!,?(68-$LENGTH(DATE)\2),DATE,!!,?5,"BED",?15,"ACCOUNT",!,?5,"SECTION",?15,"NUMBER",?27,"NAME",?55,"CLINICAL",!
QUIT
EN5 SET P=P+ST
SET Q=T_" Sub-Total"
WRITE !!,?(50-$LENGTH(Q)),Q,?55,$JUSTIFY(ST,7,4),!
+1 WRITE !,?16,K_".12",?27,"Instructional",?55,$JUSTIFY(M*P1,7,4)
SET RT=RT+(M*P1)
+2 WRITE !,?16,K_".13",?27,"Administrative",?55,$JUSTIFY(M*P2,7,4)
SET RT=RT+(M*P2)
+3 WRITE !,?16,K_".14",?27,"Continuing Education",?55,$JUSTIFY(M*P3,7,4)
SET RT=RT+(M*P3)
+4 WRITE !,?16,K_".21",?27,"Research",?55,$JUSTIFY(N,7,4),!
SET RT=RT+N
SET I=""
SET $PIECE(I,"-",59)=""
WRITE ?5,I,!
QUIT
+5 QUIT
EN6 SET M=M+$PIECE(B(Z),"^",3)
SET N=N+$PIECE(B(Z),"^",2)
SET ST=ST+$PIECE(B(Z),"^",4)
QUIT
