PXRMGECS ;SLC/JVS GEC-Reports-cont'd ;7/14/05 10:45
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
Q
;____
DFN2 ;DFN array for By Provider Report
N DFN,DOCT,DIADA,DATEV,FLAG,REF,DFN1
S REF="^TMP(""PXRMGEC"",$J)",DFN1=0
I FORMAT="D" S FOR=0
I FORMAT="F" S FOR=1
W @IOF
W "=============================================================================="
W !,"GEC Provider"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,"Report Displays Counts of Complete Referrals Only"
I FOR W !,"Provider"
I FOR W !," Patient",?17,"Completion Date",?41,"Dialog"
I 'FOR W !,"Provider^IEN^Patient^SS#^Dialog^Completion Date"
W !,"=============================================================================="
W ! D PB Q:Y=0
D E^PXRMGECV("DFN",1,BDT,EDT,"F",0)
S DOCT=0 F S DOCT=$O(@REF@("DFN",DOCT)),FLAG=1 Q:DOCT=""!(Y=0) D
.I PROV>0&('$D(PROVARY(DOCT))) Q
.I FOR W:FLAG=1 !!,IOUON,$$GET1^DIQ(200,DOCT,.01)_" ("_DOCT_")",IOUOFF,! D PB Q:Y=0
.I FOR D PB Q:Y=0
.S DFN=0 F S DFN=$O(@REF@("DFN",DOCT,DFN)) Q:DFN=""!(Y=0) D
..S DATEV=0 F S DATEV=$O(@REF@("DFN",DOCT,DFN,DATEV)) Q:DATEV="" D
...S DIADA=0 F S DIADA=$O(@REF@("DFN",DOCT,DFN,DATEV,DIADA)) Q:DIADA=""!(Y=0) D
....I FOR W !,?2,$S(DFN'=DFN1!(FLAG=1):$P($G(^DPT(DFN,0)),"^",1)_" ("_$P($G(^DPT(DFN,0)),"^",9)_")"_" ("_$$CNT^PXRMGECL(DOCT,DFN)_" Evaluation(s) )",1:"") D PB Q:Y=0
....I FOR I DFN'=DFN1!(FLAG=1) W !
....S FLAG=0
....W ?17,$P($$FMTE^XLFDT(DATEV,"5ZM"),"@",1,2),?41,$P($P($G(^PXRMD(801.41,DIADA,0)),"^",1)," ",3,6)
....S DFN1=DFN
....I FOR D PB Q:Y=0
....I 'FOR W !,$$GET1^DIQ(200,DOCT,.01)_"^"_DOCT,"^",$P($G(^DPT(DFN,0)),"^",1)_"^"_$P($G(^DPT(DFN,0)),"^",9),"^",$P($P($G(^PXRMD(801.41,DIADA,0)),"^",1)," ",3,6),"^",$P($$FMTE^XLFDT(DATEV,"5ZM"),"@",1,2)
K ^TMP("PXRMGEC",$J)
Q
;
CTL ;Referrals Counts by Location
N LOC,TOTAL,ACCTOT
S ACCTOT=0
S REF="^TMP(""PXRMGEC"",$J)"
D E^PXRMGECV("CTL",1,BDT,EDT,"F",0)
I FORMAT="D" S FOR=0
I FORMAT="F" S FOR=1
W @IOF
W "=============================================================================="
W !,"Referral Count by Location"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,"Report Displays Counts of Complete Referrals Only"
I FOR W !,"Location",?25,"Total Count"
I 'FOR W !,"Location^Total Count"
W !,"=============================================================================="
;TMP("PXRMGEC",$J,"REFLOCC",LOC)="3"
W ! D PB Q:Y=0
S LOC=0 F S LOC=$O(@REF@("REFLOCC",LOC)) Q:LOC="" D
.S TOTAL=$G(@REF@("REFLOCC",LOC)) S ACCTOT=ACCTOT+TOTAL
.I FOR W !,LOC,?25,$J(TOTAL,3)
.I 'FOR W !,LOC,"^",TOTAL
I FOR W !,"_____________________________" D PB Q:Y=0
I FOR W !,"Total Referrals",?25,$J(ACCTOT,3) D PB Q:Y=0
K ^TMP("PXRMGEC",$J)
Q
;______________________________________________________________
CTDR ;Referrals Counts by Provider
N DOC,TOTAL,ACCTOT,DIEN
S ACCTOT=0
D E^PXRMGECV("CTDR",1,BDT,EDT,"F",0)
I FORMAT="F" S FOR=1
I FORMAT="D" S FOR=0
W @IOF
W "=============================================================================="
W !,"Referral Count by Provider"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,"Report Displays Counts of Complete Referrals Only"
I FOR W !,"Provider",?37,"Total Count"
I 'FOR W !,"Provider^IEN^Total Count"
W !,"=============================================================================="
;TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)="3"
W ! D PB Q:Y=0
S DOC=0 F S DOC=$O(^TMP("PXRMGEC",$J,"REFDOCC",DOC)) Q:DOC="" D
.S DIEN=0 F S DIEN=$O(^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)) Q:DIEN="" D
..S TOTAL=$G(^TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)) S ACCTOT=ACCTOT+TOTAL
..I FOR W !,DOC," ("_DIEN_")",?37,$J(TOTAL,3)
..I 'FOR W !,DOC,"^",DIEN,"^",TOTAL
I FOR W !,"_____________________________" D PB Q:Y=0
I FOR W !,"Total Referrals",?37,$J(ACCTOT,3) D PB Q:Y=0
K ^TMP("PXRMGEC",$J)
Q
;______________________________________________________________
CTP ;Referrals Counts by Patient
N PATIENT,TOTAL,ACCTOT,CNT,DFNN,STATUS,DIV
S ACCTOT=0
D E^PXRMGECV("CTP",1,BDT,EDT,"F",0)
I FORMAT="F" S FOR=1
I FORMAT="D" S FOR=0
W @IOF
W "=============================================================================="
W !,"Referral Count by Patient"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,"Report Displays Counts of Complete Referrals Only"
I FOR W !,"Patient",?25,"SSN",?37,"Total Count",?56,"Division"
I 'FOR W !,"Patient^SSN^Total Count"
W !,"=============================================================================="
S CNT=0
;TMP("PXRMGEC",$J,"REFDFNN,PATIENT)="3"
W ! D PB Q:Y=0
S PATIENT=0 F S PATIENT=$O(^TMP("PXRMGEC",$J,"REFDFNN",PATIENT)) Q:PATIENT="" D
.S DFNN=$O(^DPT("B",PATIENT,0))
.S STATUS=$S($D(^DPT(DFNN,.1)):"INPATIENT",1:"OUTPATIENT")
.S DIV=$$GET1^DIQ(2,DFNN,.19)
.I STATUS["IN" I DIV="" S DIV="Unknown"
.S CNT=CNT+1
.S SSN=0 F S SSN=$O(^TMP("PXRMGEC",$J,"REFDFNN",PATIENT,SSN)) Q:SSN="" D
..S TOTAL=$G(^TMP("PXRMGEC",$J,"REFDFNN",PATIENT,SSN)) S ACCTOT=ACCTOT+TOTAL
..I FOR W !,CNT," ",PATIENT,?25,SSN,?37,$J(TOTAL,3),?44,STATUS,?56,DIV D PB Q:Y=0
..I 'FOR W !,PATIENT,"^",SSN,"^",TOTAL
I FOR W !,"__________________________________" D PB Q:Y=0
I FOR W !,"Total Referrals",?25,$G(SSN),?37,$J(ACCTOT,3)
K ^TMP("PXRMGEC",$J)
Q
;______________________________________________________________
CTD ;Referrals Counts by Date
N DATE,TOTAL,ACCTOT
S ACCTOT=0
D E^PXRMGECV("CTD",1,BDT,EDT,"F",0)
I FORMAT="F" S FOR=1
I FORMAT="D" S FOR=0
W @IOF
W "=============================================================================="
W !,"Referral Count by Date"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,"Report Displays Counts of Complete Referrals Only"
I FOR W !,"Date",?25,"Total Count"
I 'FOR W !,"Date^Total Count"
W !,"=============================================================================="
;TMP("PXRMGEC",$J,"REFDATE",DATE)="3"
W ! D PB Q:Y=0
S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"REFDATE",DATE)) Q:DATE="" D
.S TOTAL=$G(^TMP("PXRMGEC",$J,"REFDATE",DATE)) S ACCTOT=ACCTOT+TOTAL
.I FOR W !,$$FMTE^XLFDT(DATE,"5ZM"),?25,$J(TOTAL,3) D PB Q:Y=0
.I 'FOR W !,$$FMTE^XLFDT(DATE,"5ZM"),"^",TOTAL
I FOR W !,"_____________________________" D PB Q:Y=0
I FOR W !,"Total Referrals",?25,$J(ACCTOT,3) D PB Q:Y=0
K ^TMP("PXRMGEC",$J)
Q
;
PB ;PAGE BREAK
S Y=""
I $Y=(IOSL-2)!($Y=(IOSL-3)) D
.K DIR
.S DIR(0)="E"
.D ^DIR
.I Y=1 W @IOF S $Y=0
.W !
K DIR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECS 6657 printed Dec 13, 2024@01:45:50 Page 2
PXRMGECS ;SLC/JVS GEC-Reports-cont'd ;7/14/05 10:45
+1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+2 QUIT
+3 ;____
DFN2 ;DFN array for By Provider Report
+1 NEW DFN,DOCT,DIADA,DATEV,FLAG,REF,DFN1
+2 SET REF="^TMP(""PXRMGEC"",$J)"
SET DFN1=0
+3 IF FORMAT="D"
SET FOR=0
+4 IF FORMAT="F"
SET FOR=1
+5 WRITE @IOF
+6 WRITE "=============================================================================="
+7 WRITE !,"GEC Provider"
+8 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+9 WRITE !,"Report Displays Counts of Complete Referrals Only"
+10 IF FOR
WRITE !,"Provider"
+11 IF FOR
WRITE !," Patient",?17,"Completion Date",?41,"Dialog"
+12 IF 'FOR
WRITE !,"Provider^IEN^Patient^SS#^Dialog^Completion Date"
+13 WRITE !,"=============================================================================="
+14 WRITE !
DO PB
if Y=0
QUIT
+15 DO E^PXRMGECV("DFN",1,BDT,EDT,"F",0)
+16 SET DOCT=0
FOR
SET DOCT=$ORDER(@REF@("DFN",DOCT))
SET FLAG=1
if DOCT=""!(Y=0)
QUIT
Begin DoDot:1
+17 IF PROV>0&('$DATA(PROVARY(DOCT)))
QUIT
+18 IF FOR
if FLAG=1
WRITE !!,IOUON,$$GET1^DIQ(200,DOCT,.01)_" ("_DOCT_")",IOUOFF,!
DO PB
if Y=0
QUIT
+19 IF FOR
DO PB
if Y=0
QUIT
+20 SET DFN=0
FOR
SET DFN=$ORDER(@REF@("DFN",DOCT,DFN))
if DFN=""!(Y=0)
QUIT
Begin DoDot:2
+21 SET DATEV=0
FOR
SET DATEV=$ORDER(@REF@("DFN",DOCT,DFN,DATEV))
if DATEV=""
QUIT
Begin DoDot:3
+22 SET DIADA=0
FOR
SET DIADA=$ORDER(@REF@("DFN",DOCT,DFN,DATEV,DIADA))
if DIADA=""!(Y=0)
QUIT
Begin DoDot:4
+23 IF FOR
WRITE !,?2,$SELECT(DFN'=DFN1!(FLAG=1):$PIECE($GET(^DPT(DFN,0)),"^",1)_" ("_$PIECE($GET(^DPT(DFN,0)),"^",9)_")"_" ("_$$CNT^PXRMGECL(DOCT,DFN)_" Evaluation(s) )",1:"")
DO PB
if Y=0
QUIT
+24 IF FOR
IF DFN'=DFN1!(FLAG=1)
WRITE !
+25 SET FLAG=0
+26 WRITE ?17,$PIECE($$FMTE^XLFDT(DATEV,"5ZM"),"@",1,2),?41,$PIECE($PIECE($GET(^PXRMD(801.41,DIADA,0)),"^",1)," ",3,6)
+27 SET DFN1=DFN
+28 IF FOR
DO PB
if Y=0
QUIT
+29 IF 'FOR
WRITE !,$$GET1^DIQ(200,DOCT,.01)_"^"_DOCT,"^",$PIECE($GET(^DPT(DFN,0)),"^",1)_"^"_$PIECE($GET(^DPT(DFN,0)),"^",9),"^",$PIECE($PIECE($GET(^PXRMD(801.41,DIADA,0)),"^",1)," ",3,6),"^",$PIECE($$FMTE^XLFDT(DATEV,"
5ZM"),"@",1,2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 KILL ^TMP("PXRMGEC",$JOB)
+31 QUIT
+32 ;
CTL ;Referrals Counts by Location
+1 NEW LOC,TOTAL,ACCTOT
+2 SET ACCTOT=0
+3 SET REF="^TMP(""PXRMGEC"",$J)"
+4 DO E^PXRMGECV("CTL",1,BDT,EDT,"F",0)
+5 IF FORMAT="D"
SET FOR=0
+6 IF FORMAT="F"
SET FOR=1
+7 WRITE @IOF
+8 WRITE "=============================================================================="
+9 WRITE !,"Referral Count by Location"
+10 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+11 WRITE !,"Report Displays Counts of Complete Referrals Only"
+12 IF FOR
WRITE !,"Location",?25,"Total Count"
+13 IF 'FOR
WRITE !,"Location^Total Count"
+14 WRITE !,"=============================================================================="
+15 ;TMP("PXRMGEC",$J,"REFLOCC",LOC)="3"
+16 WRITE !
DO PB
if Y=0
QUIT
+17 SET LOC=0
FOR
SET LOC=$ORDER(@REF@("REFLOCC",LOC))
if LOC=""
QUIT
Begin DoDot:1
+18 SET TOTAL=$GET(@REF@("REFLOCC",LOC))
SET ACCTOT=ACCTOT+TOTAL
+19 IF FOR
WRITE !,LOC,?25,$JUSTIFY(TOTAL,3)
+20 IF 'FOR
WRITE !,LOC,"^",TOTAL
End DoDot:1
+21 IF FOR
WRITE !,"_____________________________"
DO PB
if Y=0
QUIT
+22 IF FOR
WRITE !,"Total Referrals",?25,$JUSTIFY(ACCTOT,3)
DO PB
if Y=0
QUIT
+23 KILL ^TMP("PXRMGEC",$JOB)
+24 QUIT
+25 ;______________________________________________________________
CTDR ;Referrals Counts by Provider
+1 NEW DOC,TOTAL,ACCTOT,DIEN
+2 SET ACCTOT=0
+3 DO E^PXRMGECV("CTDR",1,BDT,EDT,"F",0)
+4 IF FORMAT="F"
SET FOR=1
+5 IF FORMAT="D"
SET FOR=0
+6 WRITE @IOF
+7 WRITE "=============================================================================="
+8 WRITE !,"Referral Count by Provider"
+9 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+10 WRITE !,"Report Displays Counts of Complete Referrals Only"
+11 IF FOR
WRITE !,"Provider",?37,"Total Count"
+12 IF 'FOR
WRITE !,"Provider^IEN^Total Count"
+13 WRITE !,"=============================================================================="
+14 ;TMP("PXRMGEC",$J,"REFDOCC",DOC,DIEN)="3"
+15 WRITE !
DO PB
if Y=0
QUIT
+16 SET DOC=0
FOR
SET DOC=$ORDER(^TMP("PXRMGEC",$JOB,"REFDOCC",DOC))
if DOC=""
QUIT
Begin DoDot:1
+17 SET DIEN=0
FOR
SET DIEN=$ORDER(^TMP("PXRMGEC",$JOB,"REFDOCC",DOC,DIEN))
if DIEN=""
QUIT
Begin DoDot:2
+18 SET TOTAL=$GET(^TMP("PXRMGEC",$JOB,"REFDOCC",DOC,DIEN))
SET ACCTOT=ACCTOT+TOTAL
+19 IF FOR
WRITE !,DOC," ("_DIEN_")",?37,$JUSTIFY(TOTAL,3)
+20 IF 'FOR
WRITE !,DOC,"^",DIEN,"^",TOTAL
End DoDot:2
End DoDot:1
+21 IF FOR
WRITE !,"_____________________________"
DO PB
if Y=0
QUIT
+22 IF FOR
WRITE !,"Total Referrals",?37,$JUSTIFY(ACCTOT,3)
DO PB
if Y=0
QUIT
+23 KILL ^TMP("PXRMGEC",$JOB)
+24 QUIT
+25 ;______________________________________________________________
CTP ;Referrals Counts by Patient
+1 NEW PATIENT,TOTAL,ACCTOT,CNT,DFNN,STATUS,DIV
+2 SET ACCTOT=0
+3 DO E^PXRMGECV("CTP",1,BDT,EDT,"F",0)
+4 IF FORMAT="F"
SET FOR=1
+5 IF FORMAT="D"
SET FOR=0
+6 WRITE @IOF
+7 WRITE "=============================================================================="
+8 WRITE !,"Referral Count by Patient"
+9 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+10 WRITE !,"Report Displays Counts of Complete Referrals Only"
+11 IF FOR
WRITE !,"Patient",?25,"SSN",?37,"Total Count",?56,"Division"
+12 IF 'FOR
WRITE !,"Patient^SSN^Total Count"
+13 WRITE !,"=============================================================================="
+14 SET CNT=0
+15 ;TMP("PXRMGEC",$J,"REFDFNN,PATIENT)="3"
+16 WRITE !
DO PB
if Y=0
QUIT
+17 SET PATIENT=0
FOR
SET PATIENT=$ORDER(^TMP("PXRMGEC",$JOB,"REFDFNN",PATIENT))
if PATIENT=""
QUIT
Begin DoDot:1
+18 SET DFNN=$ORDER(^DPT("B",PATIENT,0))
+19 SET STATUS=$SELECT($DATA(^DPT(DFNN,.1)):"INPATIENT",1:"OUTPATIENT")
+20 SET DIV=$$GET1^DIQ(2,DFNN,.19)
+21 IF STATUS["IN"
IF DIV=""
SET DIV="Unknown"
+22 SET CNT=CNT+1
+23 SET SSN=0
FOR
SET SSN=$ORDER(^TMP("PXRMGEC",$JOB,"REFDFNN",PATIENT,SSN))
if SSN=""
QUIT
Begin DoDot:2
+24 SET TOTAL=$GET(^TMP("PXRMGEC",$JOB,"REFDFNN",PATIENT,SSN))
SET ACCTOT=ACCTOT+TOTAL
+25 IF FOR
WRITE !,CNT," ",PATIENT,?25,SSN,?37,$JUSTIFY(TOTAL,3),?44,STATUS,?56,DIV
DO PB
if Y=0
QUIT
+26 IF 'FOR
WRITE !,PATIENT,"^",SSN,"^",TOTAL
End DoDot:2
End DoDot:1
+27 IF FOR
WRITE !,"__________________________________"
DO PB
if Y=0
QUIT
+28 IF FOR
WRITE !,"Total Referrals",?25,$GET(SSN),?37,$JUSTIFY(ACCTOT,3)
+29 KILL ^TMP("PXRMGEC",$JOB)
+30 QUIT
+31 ;______________________________________________________________
CTD ;Referrals Counts by Date
+1 NEW DATE,TOTAL,ACCTOT
+2 SET ACCTOT=0
+3 DO E^PXRMGECV("CTD",1,BDT,EDT,"F",0)
+4 IF FORMAT="F"
SET FOR=1
+5 IF FORMAT="D"
SET FOR=0
+6 WRITE @IOF
+7 WRITE "=============================================================================="
+8 WRITE !,"Referral Count by Date"
+9 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+10 WRITE !,"Report Displays Counts of Complete Referrals Only"
+11 IF FOR
WRITE !,"Date",?25,"Total Count"
+12 IF 'FOR
WRITE !,"Date^Total Count"
+13 WRITE !,"=============================================================================="
+14 ;TMP("PXRMGEC",$J,"REFDATE",DATE)="3"
+15 WRITE !
DO PB
if Y=0
QUIT
+16 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"REFDATE",DATE))
if DATE=""
QUIT
Begin DoDot:1
+17 SET TOTAL=$GET(^TMP("PXRMGEC",$JOB,"REFDATE",DATE))
SET ACCTOT=ACCTOT+TOTAL
+18 IF FOR
WRITE !,$$FMTE^XLFDT(DATE,"5ZM"),?25,$JUSTIFY(TOTAL,3)
DO PB
if Y=0
QUIT
+19 IF 'FOR
WRITE !,$$FMTE^XLFDT(DATE,"5ZM"),"^",TOTAL
End DoDot:1
+20 IF FOR
WRITE !,"_____________________________"
DO PB
if Y=0
QUIT
+21 IF FOR
WRITE !,"Total Referrals",?25,$JUSTIFY(ACCTOT,3)
DO PB
if Y=0
QUIT
+22 KILL ^TMP("PXRMGEC",$JOB)
+23 QUIT
+24 ;
PB ;PAGE BREAK
+1 SET Y=""
+2 IF $Y=(IOSL-2)!($Y=(IOSL-3))
Begin DoDot:1
+3 KILL DIR
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 IF Y=1
WRITE @IOF
SET $Y=0
+7 WRITE !
End DoDot:1
+8 KILL DIR
+9 QUIT
+10 ;
