- 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 Jan 18, 2025@02:47:55 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