Routine: ADEKNT6

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!"

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

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

ADEKNT6.m