- ADEPSUB1 ; IHS/HQT/MJL - PRINT SUBROUTINES ; [ 08/01/2001 1:06 PM ]
- ;;6.0;ADE;**9**;APRIL 1999
- ;
- DDS() ;EP - Returns "1/0"
- ;AND SETS UP ARRAY ADEDNAM(DFN)="DENTIST,NAME"
- N ADEDDS,ADEJ
- S ADEDDS=""
- S ADEJ=0
- F S ADEJ=$O(^DIC(6,ADEJ)) Q:'+ADEJ D
- . I $D(^DIC(6,ADEJ,0)),$P(^DIC(6,ADEJ,0),U,4)]"",$D(^DIC(7,$P(^DIC(6,ADEJ,0),U,4),9999999)),+^DIC(7,$P(^DIC(6,ADEJ,0),U,4),9999999)=52 D
- . . ;I ADEDDS="" S ADEDDS=ADEJ Q
- . . ;S $P(ADEDDS,",",$L(ADEDDS,",")+1)=ADEJ
- . . Q:'$D(^DIC(16,ADEJ,0))
- . . S ADEDDS=1
- . . S ADEDNAM(ADEJ)=$P(^DIC(16,ADEJ,0),U)
- I ADEDDS="" Q 0
- ;F ADEJ=1:1:$L(ADEDDS,",") S ADEDNAM($P(ADEDDS,",",ADEJ))=$P(^DIC(16,$P(ADEDDS,",",ADEJ),0),U)
- ;S ADEDDS="1^"_ADEDDS
- Q ADEDDS
- ;
- HYG() ;EP - Returns "1/0^DFN,DFN,DFN"
- ;AND SETS UP ARRAY ADEHNAM(DFN)="HYGIENIST,NAME"
- N ADEHYG,ADEJ,ADEK,ADEL
- S ADEHYG=""
- S ADEJ=0
- F S ADEJ=$O(^DIC(6,ADEJ)) Q:'+ADEJ D
- . I $D(^DIC(6,ADEJ,0)),$P(^DIC(6,ADEJ,0),U,4)]"",$D(^DIC(7,$P(^DIC(6,ADEJ,0),U,4),9999999)),+^DIC(7,$P(^DIC(6,ADEJ,0),U,4),9999999)=46 D
- . . Q:'$D(^DIC(16,ADEJ,0))
- . . S ADEHNAM(ADEJ)=$P(^DIC(16,ADEJ,0),U)
- . . I ADEHYG="" S ADEHYG=ADEJ Q
- . . S $P(ADEHYG,",",$L(ADEHYG,",")+1)=ADEJ Q
- I ADEHYG="" Q 0
- S ADEHYG="1^"_ADEHYG
- Q ADEHYG
- ;
- DSERIES ;EP - SETS ADESER ARRAY FOR DENTIST REPORTS
- N ADEK
- F ADEK="ADEPHY-V","HYG/THER DATA ENTRY CHECK" D
- . S ADESER(ADEK)=$O(^ADEDIT("GRP","B",ADEK,0))
- . S ADESER(ADEK)=^ADEDIT("GRP",ADESER(ADEK),1)
- Q
- ;
- HSERIES ;EP - SETS ADESER ARRAY FOR HYGIENIST REPORTS
- N ADEK
- F ADEK="V",0:1:4,8,9 D
- . S ADESER(ADEK)=$O(^ADEDIT("GRP","B","ADEPHY-"_ADEK,0))
- . S ADESER(ADEK)=^ADEDIT("GRP",ADESER(ADEK),1) ;MJL/HQT/IHS 8/31/01
- Q
- ;
- CALC4 ;EP - $O THRU ADEREP AND SET % MINUTES OF EACH SUBTOTAL NODE
- ;FOR REPORTS WITH 4 TIME PERIODS
- N ADEJ,ADEK,ADETOTM,ADESUBM
- S ADEJ=0
- F S ADEJ=$O(^TMP("ADEP",ADEU,ADEJ)) Q:ADEJ="" D
- . Q:'$D(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"))
- . S ADETOTM=$P(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"),U,5)
- . S:'ADETOTM ADETOTM=1
- . S ADEK=0
- . F S ADEK=$O(^TMP("ADEP",ADEU,ADEJ,ADEK)) Q:+ADEK=8 D
- . . Q:'$D(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"))
- . . S ADESUBM=$P(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,5)
- . . S $P(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,6)=$J((ADESUBM/ADETOTM)*100,5,1)_"%" ;^TMP is a transient working global
- K ADETOTM,ADESUBM,ADEJ,ADEK
- Q
- ;
- CALC3 ;EP - FOR REPORTS WITH 3 TIME PERIODS
- N ADEJ,ADEK,ADETOTM,ADESUBM
- S ADEJ=0
- F S ADEJ=$O(^TMP("ADEP",ADEU,ADEJ)) Q:ADEJ="" D
- . Q:'$D(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"))
- . S ADETOTM=$P(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"),U,4)
- . S:'ADETOTM ADETOTM=1
- . S ADEK=0
- . F S ADEK=$O(^TMP("ADEP",ADEU,ADEJ,ADEK)) Q:+ADEK=8 D
- . . Q:'$D(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"))
- . . S ADESUBM=$P(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,4)
- . . S $P(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,5)=$J((ADESUBM/ADETOTM)*100,5,1)_"%" ;^TMP is a transient working global
- K ADETOTM,ADESUBM,ADEJ,ADEK
- Q
- ADEPSUB1 ; IHS/HQT/MJL - PRINT SUBROUTINES ; [ 08/01/2001 1:06 PM ]
- +1 ;;6.0;ADE;**9**;APRIL 1999
- +2 ;
- DDS() ;EP - Returns "1/0"
- +1 ;AND SETS UP ARRAY ADEDNAM(DFN)="DENTIST,NAME"
- +2 NEW ADEDDS,ADEJ
- +3 SET ADEDDS=""
- +4 SET ADEJ=0
- +5 FOR
- SET ADEJ=$ORDER(^DIC(6,ADEJ))
- IF '+ADEJ
- QUIT
- Begin DoDot:1
- +6 IF $DATA(^DIC(6,ADEJ,0))
- IF $PIECE(^DIC(6,ADEJ,0),U,4)]""
- IF $DATA(^DIC(7,$PIECE(^DIC(6,ADEJ,0),U,4),9999999))
- IF +^DIC(7,$PIECE(^DIC(6,ADEJ,0),U,4),9999999)=52
- Begin DoDot:2
- +7 ;I ADEDDS="" S ADEDDS=ADEJ Q
- +8 ;S $P(ADEDDS,",",$L(ADEDDS,",")+1)=ADEJ
- +9 IF '$DATA(^DIC(16,ADEJ,0))
- QUIT
- +10 SET ADEDDS=1
- +11 SET ADEDNAM(ADEJ)=$PIECE(^DIC(16,ADEJ,0),U)
- End DoDot:2
- End DoDot:1
- +12 IF ADEDDS=""
- QUIT 0
- +13 ;F ADEJ=1:1:$L(ADEDDS,",") S ADEDNAM($P(ADEDDS,",",ADEJ))=$P(^DIC(16,$P(ADEDDS,",",ADEJ),0),U)
- +14 ;S ADEDDS="1^"_ADEDDS
- +15 QUIT ADEDDS
- +16 ;
- HYG() ;EP - Returns "1/0^DFN,DFN,DFN"
- +1 ;AND SETS UP ARRAY ADEHNAM(DFN)="HYGIENIST,NAME"
- +2 NEW ADEHYG,ADEJ,ADEK,ADEL
- +3 SET ADEHYG=""
- +4 SET ADEJ=0
- +5 FOR
- SET ADEJ=$ORDER(^DIC(6,ADEJ))
- IF '+ADEJ
- QUIT
- Begin DoDot:1
- +6 IF $DATA(^DIC(6,ADEJ,0))
- IF $PIECE(^DIC(6,ADEJ,0),U,4)]""
- IF $DATA(^DIC(7,$PIECE(^DIC(6,ADEJ,0),U,4),9999999))
- IF +^DIC(7,$PIECE(^DIC(6,ADEJ,0),U,4),9999999)=46
- Begin DoDot:2
- +7 IF '$DATA(^DIC(16,ADEJ,0))
- QUIT
- +8 SET ADEHNAM(ADEJ)=$PIECE(^DIC(16,ADEJ,0),U)
- +9 IF ADEHYG=""
- SET ADEHYG=ADEJ
- QUIT
- +10 SET $PIECE(ADEHYG,",",$LENGTH(ADEHYG,",")+1)=ADEJ
- QUIT
- End DoDot:2
- End DoDot:1
- +11 IF ADEHYG=""
- QUIT 0
- +12 SET ADEHYG="1^"_ADEHYG
- +13 QUIT ADEHYG
- +14 ;
- DSERIES ;EP - SETS ADESER ARRAY FOR DENTIST REPORTS
- +1 NEW ADEK
- +2 FOR ADEK="ADEPHY-V","HYG/THER DATA ENTRY CHECK"
- Begin DoDot:1
- +3 SET ADESER(ADEK)=$ORDER(^ADEDIT("GRP","B",ADEK,0))
- +4 SET ADESER(ADEK)=^ADEDIT("GRP",ADESER(ADEK),1)
- End DoDot:1
- +5 QUIT
- +6 ;
- HSERIES ;EP - SETS ADESER ARRAY FOR HYGIENIST REPORTS
- +1 NEW ADEK
- +2 FOR ADEK="V",0:1:4,8,9
- Begin DoDot:1
- +3 SET ADESER(ADEK)=$ORDER(^ADEDIT("GRP","B","ADEPHY-"_ADEK,0))
- +4 ;MJL/HQT/IHS 8/31/01
- SET ADESER(ADEK)=^ADEDIT("GRP",ADESER(ADEK),1)
- End DoDot:1
- +5 QUIT
- +6 ;
- CALC4 ;EP - $O THRU ADEREP AND SET % MINUTES OF EACH SUBTOTAL NODE
- +1 ;FOR REPORTS WITH 4 TIME PERIODS
- +2 NEW ADEJ,ADEK,ADETOTM,ADESUBM
- +3 SET ADEJ=0
- +4 FOR
- SET ADEJ=$ORDER(^TMP("ADEP",ADEU,ADEJ))
- IF ADEJ=""
- QUIT
- Begin DoDot:1
- +5 IF '$DATA(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"))
- QUIT
- +6 SET ADETOTM=$PIECE(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"),U,5)
- +7 IF 'ADETOTM
- SET ADETOTM=1
- +8 SET ADEK=0
- +9 FOR
- SET ADEK=$ORDER(^TMP("ADEP",ADEU,ADEJ,ADEK))
- IF +ADEK=8
- QUIT
- Begin DoDot:2
- +10 IF '$DATA(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"))
- QUIT
- +11 SET ADESUBM=$PIECE(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,5)
- +12 ;^TMP is a transient working global
- SET $PIECE(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,6)=$JUSTIFY((ADESUBM/ADETOTM)*100,5,1)_"%"
- End DoDot:2
- End DoDot:1
- +13 KILL ADETOTM,ADESUBM,ADEJ,ADEK
- +14 QUIT
- +15 ;
- CALC3 ;EP - FOR REPORTS WITH 3 TIME PERIODS
- +1 NEW ADEJ,ADEK,ADETOTM,ADESUBM
- +2 SET ADEJ=0
- +3 FOR
- SET ADEJ=$ORDER(^TMP("ADEP",ADEU,ADEJ))
- IF ADEJ=""
- QUIT
- Begin DoDot:1
- +4 IF '$DATA(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"))
- QUIT
- +5 SET ADETOTM=$PIECE(^TMP("ADEP",ADEU,ADEJ,"8. TOTAL"),U,4)
- +6 IF 'ADETOTM
- SET ADETOTM=1
- +7 SET ADEK=0
- +8 FOR
- SET ADEK=$ORDER(^TMP("ADEP",ADEU,ADEJ,ADEK))
- IF +ADEK=8
- QUIT
- Begin DoDot:2
- +9 IF '$DATA(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"))
- QUIT
- +10 SET ADESUBM=$PIECE(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,4)
- +11 ;^TMP is a transient working global
- SET $PIECE(^TMP("ADEP",ADEU,ADEJ,ADEK,"SUBTOTAL"),U,5)=$JUSTIFY((ADESUBM/ADETOTM)*100,5,1)_"%"
- End DoDot:2
- End DoDot:1
- +12 KILL ADETOTM,ADESUBM,ADEJ,ADEK
- +13 QUIT
