ADEKNT6 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
;
;Send mail message with California FY statistics.
;Enter at top to receive prompt for fiscal year.
;Enter at CFBULL for non-interactive creation of mailman
;message containing fiscal year statistics.
;
N ADEYQ
S ADEYQ=$$ASKFY^ADEKNT61()
Q:'+ADEYQ
D CFBULL(ADEYQ)
W !!,"Message Created!"
Q
;
;
CFBULL(ADEYQ) ;EP
;Y2K - FHL 09/04/98 ADEYQ="YYYY.Q" and Q must = 3
Q:$P(ADEYQ,".",2)'=3 ;FY Year-end only
;Y2K - FHL 09/04/98
Q:$L($P(ADEYQ,".",1))'=4 ;Y2000
;
N XMB,XMDUZ,ADEED,ADEBD,ADEPER,ADE,ADEBA,ADEAGE,ADEFY
S ADEPER=$$PERIOD^ADEKNT5($P(ADEYQ,"."),$P(ADEYQ,".",2))
S ADEBD=$P(ADEPER,U,4)
S ADEED=$P(ADEPER,U,2)
;Y2K - FHL 09/04/98
;S ADEFY=$E(ADEED,2,3)
;Y2K - FHL 09/04/98
S ADEFY=1700+$E(ADEED,1,3) ;Y2000
S Y=ADEBD X ^DD("DD") S ADEBD=Y
S Y=ADEED X ^DD("DD") S ADEED=Y
D CONST^ADEKRP5 ;Load ADE() array with constants
S ADEAGE="0:125"
;
S XMB="ADEK-CALIF"
S XMDUZ="THE DENTAL REPORT BULLETIN"
;Set the XMB() array
;
S XMB(10)="" ;RPMS Site
S XMB(10)=$O(^ADEPARAM(0)),XMB(10)=$P(^ADEPARAM(XMB(10),0),U),XMB(10)=$P(^DIC(4,XMB(10),0),U)
;
S XMB(20)=ADEFY ;Fiscal year corresponding to ADEYQ
S XMB(30)=ADEBD,XMB(40)=ADEED
S XMB(45)=$$FMAT("^Indian^Non-Indian^Total")
;
S $P(XMB(50),U)="Total Individual Patients Seen (0000)"
S $P(XMB(50),U,2)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("PTS IND"),ADEAGE),U,2)
S $P(XMB(50),U,3)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("PTS NON-IND"),ADEAGE),U,2)
S $P(XMB(50),U,4)=$P(XMB(50),U,2)+$P(XMB(50),U,3)
S XMB(50)=$$FMAT(XMB(50))
;
S $P(XMB(60),U)="Total Visits"
S $P(XMB(60),U,2)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("VIS IND"),ADEAGE),U,2)
S $P(XMB(60),U,3)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("VIS NON-IND"),ADEAGE),U,2)
S $P(XMB(60),U,4)=$P(XMB(60),U,2)+$P(XMB(60),U,3)
S XMB(60)=$$FMAT(XMB(60))
;
S $P(XMB(70),U)="Total Clinical Services"
S $P(XMB(70),U,2)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("SVC IND"),ADEAGE),U,2)
S $P(XMB(70),U,3)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("SVC NON-IND"),ADEAGE),U,2)
S $P(XMB(70),U,4)=$P(XMB(70),U,2)+$P(XMB(70),U,3)
S XMB(70)=$$FMAT(XMB(70))
;
S $P(XMB(80),U)="Total Clinical Service Minutes"
S $P(XMB(80),U,2)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("MIN IND"),ADEAGE),U,2)
S $P(XMB(80),U,3)=$P($$GETCNT^ADEKRP(ADEYQ,ADE("MIN NON-IND"),ADEAGE),U,2)
S $P(XMB(80),U,4)=$P(XMB(80),U,2)+$P(XMB(80),U,3)
S XMB(80)=$$FMAT(XMB(80))
;
S ADEBA=$P($$GETCNT^ADEKRP(ADEYQ,ADE("BA"),ADEAGE),U,2)
S XMB(90)="Number of Broken Appointments for FY"_ADEFY_": "_ADEBA
S XMB(90)=XMB(90)_" = "_(ADEBA/2)_" Hours"
;
;Call ^XMB
D ^XMB
Q
;
FMAT(ADELIN) ;EP
;ADELIN is a 4-^ piece string where
;piece 1 is row label and pieces 2,3,4 are values
;
;This function returns row label padded to 40
;and values right justified in 13-column spaces
;
N ADES,ADELBL,ADEV,J
S $P(ADES," ",80)=""
S ADELBL=$P(ADELIN,U)
S ADELBL=ADELBL_ADES
S ADELBL=$E(ADELBL,1,40)
;
F J=2:1:4 D
. S ADEV=$P(ADELIN,U,J)
. S ADEV=$J(ADEV,13)
. S ADELBL=ADELBL_ADEV
;
Q ADELBL
ADEKNT6 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 ;
+3 ;Send mail message with California FY statistics.
+4 ;Enter at top to receive prompt for fiscal year.
+5 ;Enter at CFBULL for non-interactive creation of mailman
+6 ;message containing fiscal year statistics.
+7 ;
+8 NEW ADEYQ
+9 SET ADEYQ=$$ASKFY^ADEKNT61()
+10 IF '+ADEYQ
QUIT
+11 DO CFBULL(ADEYQ)
+12 WRITE !!,"Message Created!"
+13 QUIT
+14 ;
+15 ;
CFBULL(ADEYQ) ;EP
+1 ;Y2K - FHL 09/04/98 ADEYQ="YYYY.Q" and Q must = 3
+2 ;FY Year-end only
IF $PIECE(ADEYQ,".",2)'=3
QUIT
+3 ;Y2K - FHL 09/04/98
+4 ;Y2000
IF $LENGTH($PIECE(ADEYQ,".",1))'=4
QUIT
+5 ;
+6 NEW XMB,XMDUZ,ADEED,ADEBD,ADEPER,ADE,ADEBA,ADEAGE,ADEFY
+7 SET ADEPER=$$PERIOD^ADEKNT5($PIECE(ADEYQ,"."),$PIECE(ADEYQ,".",2))
+8 SET ADEBD=$PIECE(ADEPER,U,4)
+9 SET ADEED=$PIECE(ADEPER,U,2)
+10 ;Y2K - FHL 09/04/98
+11 ;S ADEFY=$E(ADEED,2,3)
+12 ;Y2K - FHL 09/04/98
+13 ;Y2000
SET ADEFY=1700+$EXTRACT(ADEED,1,3)
+14 SET Y=ADEBD
XECUTE ^DD("DD")
SET ADEBD=Y
+15 SET Y=ADEED
XECUTE ^DD("DD")
SET ADEED=Y
+16 ;Load ADE() array with constants
DO CONST^ADEKRP5
+17 SET ADEAGE="0:125"
+18 ;
+19 SET XMB="ADEK-CALIF"
+20 SET XMDUZ="THE DENTAL REPORT BULLETIN"
+21 ;Set the XMB() array
+22 ;
+23 ;RPMS Site
SET XMB(10)=""
+24 SET XMB(10)=$ORDER(^ADEPARAM(0))
SET XMB(10)=$PIECE(^ADEPARAM(XMB(10),0),U)
SET XMB(10)=$PIECE(^DIC(4,XMB(10),0),U)
+25 ;
+26 ;Fiscal year corresponding to ADEYQ
SET XMB(20)=ADEFY
+27 SET XMB(30)=ADEBD
SET XMB(40)=ADEED
+28 SET XMB(45)=$$FMAT("^Indian^Non-Indian^Total")
+29 ;
+30 SET $PIECE(XMB(50),U)="Total Individual Patients Seen (0000)"
+31 SET $PIECE(XMB(50),U,2)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("PTS IND"),ADEAGE),U,2)
+32 SET $PIECE(XMB(50),U,3)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("PTS NON-IND"),ADEAGE),U,2)
+33 SET $PIECE(XMB(50),U,4)=$PIECE(XMB(50),U,2)+$PIECE(XMB(50),U,3)
+34 SET XMB(50)=$$FMAT(XMB(50))
+35 ;
+36 SET $PIECE(XMB(60),U)="Total Visits"
+37 SET $PIECE(XMB(60),U,2)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("VIS IND"),ADEAGE),U,2)
+38 SET $PIECE(XMB(60),U,3)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("VIS NON-IND"),ADEAGE),U,2)
+39 SET $PIECE(XMB(60),U,4)=$PIECE(XMB(60),U,2)+$PIECE(XMB(60),U,3)
+40 SET XMB(60)=$$FMAT(XMB(60))
+41 ;
+42 SET $PIECE(XMB(70),U)="Total Clinical Services"
+43 SET $PIECE(XMB(70),U,2)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("SVC IND"),ADEAGE),U,2)
+44 SET $PIECE(XMB(70),U,3)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("SVC NON-IND"),ADEAGE),U,2)
+45 SET $PIECE(XMB(70),U,4)=$PIECE(XMB(70),U,2)+$PIECE(XMB(70),U,3)
+46 SET XMB(70)=$$FMAT(XMB(70))
+47 ;
+48 SET $PIECE(XMB(80),U)="Total Clinical Service Minutes"
+49 SET $PIECE(XMB(80),U,2)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("MIN IND"),ADEAGE),U,2)
+50 SET $PIECE(XMB(80),U,3)=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("MIN NON-IND"),ADEAGE),U,2)
+51 SET $PIECE(XMB(80),U,4)=$PIECE(XMB(80),U,2)+$PIECE(XMB(80),U,3)
+52 SET XMB(80)=$$FMAT(XMB(80))
+53 ;
+54 SET ADEBA=$PIECE($$GETCNT^ADEKRP(ADEYQ,ADE("BA"),ADEAGE),U,2)
+55 SET XMB(90)="Number of Broken Appointments for FY"_ADEFY_": "_ADEBA
+56 SET XMB(90)=XMB(90)_" = "_(ADEBA/2)_" Hours"
+57 ;
+58 ;Call ^XMB
+59 DO ^XMB
+60 QUIT
+61 ;
FMAT(ADELIN) ;EP
+1 ;ADELIN is a 4-^ piece string where
+2 ;piece 1 is row label and pieces 2,3,4 are values
+3 ;
+4 ;This function returns row label padded to 40
+5 ;and values right justified in 13-column spaces
+6 ;
+7 NEW ADES,ADELBL,ADEV,J
+8 SET $PIECE(ADES," ",80)=""
+9 SET ADELBL=$PIECE(ADELIN,U)
+10 SET ADELBL=ADELBL_ADES
+11 SET ADELBL=$EXTRACT(ADELBL,1,40)
+12 ;
+13 FOR J=2:1:4
Begin DoDot:1
+14 SET ADEV=$PIECE(ADELIN,U,J)
+15 SET ADEV=$JUSTIFY(ADEV,13)
+16 SET ADELBL=ADELBL_ADEV
End DoDot:1
+17 ;
+18 QUIT ADELBL
