DGMUSTAT ;KNR/WCS - PREFERRED LANGUAGE RECORD FOR ACTIVE PATIENTS ; July 16, 2014
;;5.3;Registration;**887**;Aug 13, 1993;Build 57
;
EN ;*///*
D HOME^%ZIS
W @IOF,"Preferred Language Record for Active Patients",!!!
W "This program will calculate the number of patients who have designated",!
W "a preferred language in their record at this facility.",!!
S %ZIS="AEQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) DO G EXIT
.S ZTIO=ION,ZTSAVE="",ZTRTN="GO^DGMUSTAT",ZTDESC="Meaningful Use Statistics"
.D ^%ZTLOAD W:$D(ZTSK) !,"Queued as task: ",ZTSK,!!
;
GO S DGPATCNT=0 K DGLANG
S DGSSN="" F S DGSSN=$O(^DPT("SSN",DGSSN)) Q:DGSSN="" DO
.F DFN=0:0 S DFN=$O(^DPT("SSN",DGSSN,DFN)) Q:DFN="" DO
..Q:$P($G(^DPT(DFN,.35)),U)]"" ; deceased patients
..S DGPATCNT=DGPATCNT+1 ; count total patients
..S DGDATE="9999999.9999",DGDATE=$O(^DPT(DFN,.207,"B",DGDATE),-1) Q:DGDATE=""
..S DA=$O(^DPT(DFN,.207,"B",DGDATE,0)) Q:DA=""
..S DGDATA=$G(^DPT(DFN,.207,DA,0)) Q:DGDATA=""
..S DGLANGNM=$P(DGDATA,U,2) ; Language name
..I DGLANGNM]"" S DGLANG(DGLANGNM)=$G(DGLANG(DGLANGNM))+1 ; count language names
;
PRINT U IO S PG=0
S DGTOTPTL=0 S DGLANGNM="" F S DGLANGNM=$O(DGLANG(DGLANGNM)) Q:DGLANGNM="" S DGTOTPTL=DGTOTPTL+DGLANG(DGLANGNM)
D HDR
S DOTS="........................."
W !! S DGLANGNM="",DGLANGCT=0 F S DGLANGNM=$O(DGLANG(DGLANGNM)) Q:DGLANGNM="" DO
.W DGLANGNM," ",$E(DOTS,2,(25-$X)),?25,DGLANG(DGLANGNM),! S DGLANGCT=DGLANGCT+1 I $Y>(IOSL-7) D HDR
W !!
I DGLANGCT>0 S X=(DGTOTPTL/DGPATCNT)*100
I DGLANGCT=0 S X="0.00"
W ?12,"Total Count of Patient Records: ",DGPATCNT,!
W ?4,"Total Patients with preferred language: ",DGTOTPTL,!!
W ?10,"Total unique preferred languages: ",DGLANGCT,!
W " % Patient records with preferred language: ",$J(X,0,1)," %",!
;
EXIT K %ZIS,DA,DFN,DGDATA,DGDATE,DGLANG,DGLANGCT,DGLANGNM,DGLANGPT,DGPATCNT,DGSSN,DGTOTPTL,DOTS,PG,X
K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
;
HDR S PG=PG+1
W @IOF,"Preferred Language Record for Active Patients",?(IOM-12),"Page: ",PG,!!
W "Language",?25,"Count",!
F X=1:1:IOM W "-"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMUSTAT 2105 printed Apr 09, 2024@21:43:18 Page 2
DGMUSTAT ;KNR/WCS - PREFERRED LANGUAGE RECORD FOR ACTIVE PATIENTS ; July 16, 2014
+1 ;;5.3;Registration;**887**;Aug 13, 1993;Build 57
+2 ;
EN ;*///*
+1 DO HOME^%ZIS
+2 WRITE @IOF,"Preferred Language Record for Active Patients",!!!
+3 WRITE "This program will calculate the number of patients who have designated",!
+4 WRITE "a preferred language in their record at this facility.",!!
+5 SET %ZIS="AEQ"
DO ^%ZIS
if POP
GOTO EXIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTIO=ION
SET ZTSAVE=""
SET ZTRTN="GO^DGMUSTAT"
SET ZTDESC="Meaningful Use Statistics"
+8 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued as task: ",ZTSK,!!
End DoDot:1
GOTO EXIT
+9 ;
GO SET DGPATCNT=0
KILL DGLANG
+1 SET DGSSN=""
FOR
SET DGSSN=$ORDER(^DPT("SSN",DGSSN))
if DGSSN=""
QUIT
Begin DoDot:1
+2 FOR DFN=0:0
SET DFN=$ORDER(^DPT("SSN",DGSSN,DFN))
if DFN=""
QUIT
Begin DoDot:2
+3 ; deceased patients
if $PIECE($GET(^DPT(DFN,.35)),U)]""
QUIT
+4 ; count total patients
SET DGPATCNT=DGPATCNT+1
+5 SET DGDATE="9999999.9999"
SET DGDATE=$ORDER(^DPT(DFN,.207,"B",DGDATE),-1)
if DGDATE=""
QUIT
+6 SET DA=$ORDER(^DPT(DFN,.207,"B",DGDATE,0))
if DA=""
QUIT
+7 SET DGDATA=$GET(^DPT(DFN,.207,DA,0))
if DGDATA=""
QUIT
+8 ; Language name
SET DGLANGNM=$PIECE(DGDATA,U,2)
+9 ; count language names
IF DGLANGNM]""
SET DGLANG(DGLANGNM)=$GET(DGLANG(DGLANGNM))+1
End DoDot:2
End DoDot:1
+10 ;
PRINT USE IO
SET PG=0
+1 SET DGTOTPTL=0
SET DGLANGNM=""
FOR
SET DGLANGNM=$ORDER(DGLANG(DGLANGNM))
if DGLANGNM=""
QUIT
SET DGTOTPTL=DGTOTPTL+DGLANG(DGLANGNM)
+2 DO HDR
+3 SET DOTS="........................."
+4 WRITE !!
SET DGLANGNM=""
SET DGLANGCT=0
FOR
SET DGLANGNM=$ORDER(DGLANG(DGLANGNM))
if DGLANGNM=""
QUIT
Begin DoDot:1
+5 WRITE DGLANGNM," ",$EXTRACT(DOTS,2,(25-$X)),?25,DGLANG(DGLANGNM),!
SET DGLANGCT=DGLANGCT+1
IF $Y>(IOSL-7)
DO HDR
End DoDot:1
+6 WRITE !!
+7 IF DGLANGCT>0
SET X=(DGTOTPTL/DGPATCNT)*100
+8 IF DGLANGCT=0
SET X="0.00"
+9 WRITE ?12,"Total Count of Patient Records: ",DGPATCNT,!
+10 WRITE ?4,"Total Patients with preferred language: ",DGTOTPTL,!!
+11 WRITE ?10,"Total unique preferred languages: ",DGLANGCT,!
+12 WRITE " % Patient records with preferred language: ",$JUSTIFY(X,0,1)," %",!
+13 ;
EXIT KILL %ZIS,DA,DFN,DGDATA,DGDATE,DGLANG,DGLANGCT,DGLANGNM,DGLANGPT,DGPATCNT,DGSSN,DGTOTPTL,DOTS,PG,X
+1 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 QUIT
+3 ;
HDR SET PG=PG+1
+1 WRITE @IOF,"Preferred Language Record for Active Patients",?(IOM-12),"Page: ",PG,!!
+2 WRITE "Language",?25,"Count",!
+3 FOR X=1:1:IOM
WRITE "-"
+4 QUIT
