PXRMGECR ;SLC/JVS GEC-Reports ;7/14/05 10:44
;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
Q
LOC ;Referrals by Location
N CAT,HF,DATE,DFN,Y,HFN,DFNXX
D E^PXRMGECV("LOC",1,BDT,EDT,"F",0)
I FORMAT="F" S FOR=1
I FORMAT="D" S FOR=0
W @IOF
W "=============================================================================="
W !,"Complete GEC Referrals by Location"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
I FOR W !,"Location"
I FOR W !,?5,"Patient",?50,"Finish Date"
I 'FOR W !,"Location^Location Count^Patient^SSN^Finish Date"
W !,"=============================================================================="
W ! D PB Q:Y=0
S LOCN="" F S LOCN=$O(^TMP("PXRMGEC",$J,"TMPLOC",LOCN)) Q:LOCN=""!(Y=0) D
.Q:LOCNP'=1&(LOCN'=LOCNP)
.I FOR W ! D PB Q:Y=0
.I FOR W !,IOUON,LOCN,IOUOFF,?30,"Total # Patients Evaluated= ",$G(^TMP("PXRMGEC",$J,"REFLOCC",LOCN)) D PB Q:Y=0
.I FOR W ! D PB Q:Y=0
.S DFNXX="" F S DFNXX=$O(^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX)) Q:DFNXX=""!(Y=0) D
..S VDT=0 F S VDT=$O(^TMP("PXRMGEC",$J,"TMPLOC",LOCN,DFNXX,VDT)) Q:VDT=""!(Y=0) D
...I VDT["0000" I FOR W !,?5,DFNXX,?50,"Incomplete"
...E I FOR W !,?5,$P(DFNXX," ",1,$L(DFNXX," ")-1)," ("_$P(DFNXX," ",$L(DFNXX," "))_")",?50,$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1)
...I FOR D PB Q:Y=0
...I 'FOR W !,LOCN,"^",$G(^TMP("PXRMGEC",$J,"REFLOCC",LOCN)),"^",$P(DFNXX," ",1,$L(DFNXX," ")-1),"^",$P(DFNXX," ",$L(DFNXX," ")),"^",$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1)
K ^TMP("PXRMGEC",$J)
Q
;_______
DR ;Referrals by Date Range
N CAT,HF,DATE,DFN,Y,HFN,CNTREF,DIF,DIFF
D E^PXRMGECV("HS1",INC,BDT,EDT,$S(INC=1:"F",1:"S"),DFNONLY)
I FORMAT="D" S FOR=0
I FORMAT="F" S FOR=1
W @IOF
W "=============================================================================="
W !,"Complete and/or Incomplete GEC Referrals by Date Range"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,$S(INC=0:"Incomplete",INC=1:"Complete",INC=2:"Complete and Incomplete",1:"")_" Referrals"
I FOR W !,"Patient"
I INC=1 I FOR W !,?5,"Start Date",?20,"Finished",?35,"Elapsed Time"
E I FOR W !,?5,"Start Date",?20,"Finished",?35,"Elapsed Time",?50,"Incomplete Status"
I 'FOR W !,"Patient^SS#^Count^Start Date^Finished Date^Elapsed Time"
W !,"=============================================================================="
W ! D PB Q:Y=0
S DFN="" F S DFN=$O(^TMP("PXRMGEC",$J,"HS1",DFN)) Q:DFN=""!(Y=0) D
.I FOR W ! D PB Q:Y=0
.I FOR W !,IOUON,$P(DFN," ",1,$L(DFN," ")-1)," ("_$P(DFN," ",$L(DFN," "))_")"," ",IOUOFF
.I FOR W ?44,$G(^TMP("PXRMGEC",$J,"REFDFNN",$P(DFN," ",1,($L(DFN," ")-1))))," Referral(s)" D PB Q:Y=0
.I FOR W ! D PB Q:Y=0
.S CNTREF="" F S CNTREF=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF)) Q:CNTREF=""!(Y=0) D
..S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE)) Q:DATE=""!(Y=0) D
...S VDT=0 F S VDT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT)) Q:VDT=""!(Y=0) D
....S DIFF="" I VDT>0 S DIFF=$$FMDIFF^XLFDT(VDT,DATE,1)+1
....S DIF="" S DIF=$$FMDIFF^XLFDT(DT,DATE,1)+1
....I VDT["0000" I FOR W !,?5,$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1),?20,"",?35,$S(DIFF="":DIF_" Days",DIFF>0:DIFF_" Days",1:""),?50,$S(DIFF="":"Incomplete",1:"")
....E I FOR W !,?5,$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1),?20,$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1),?35,$S(DIFF="":DIF_" Days",DIFF>0:DIFF_" Days",1:""),?50,$S(DIFF="":"Incomplete",1:"")
....I FOR D PB Q:Y=0
....I 'FOR W !,$P(DFN," ",1,$L(DFN," ")-1),"^",$P(DFN," ",$L(DFN," ")),"^"
....I 'FOR W $G(^TMP("PXRMGEC",$J,"REFDFNN",$P(DFN," ",1,$L(DFN," ")-1))),"^",$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1),"^",$P($$FMTE^XLFDT(VDT,"5ZM"),"@",1),"^",$S(DIFF="":DIF,DIFF>0:DIFF,1:"")
K ^TMP("PXRMGEC",$J)
Q
;_____
HS1 ;By Patient
N CAT,HF,DATE,DFN,Y,HFN,CNTREF,X,REFNUM,CNT,STATUS,NAME,DIV
D E^PXRMGECV("HS1",1,BDT,EDT,"F",DFNONLY)
I FORMAT="D" S FOR=0
I FORMAT="F" S FOR=1
W @IOF
W "=============================================================================="
W !,"GEC Patient"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
I FOR W !,"Patient"
I FOR W !," Category"
I FOR W !," Health Factor",?44,"Value",?55,"Date of Evaluation"
I 'FOR W !,"Patient^Category^Health Factor^Value^Date of Evaluation"
W !,"=============================================================================="
S CNT=0
S Y=1
S DFN="" F S DFN=$O(^TMP("PXRMGEC",$J,"HS1",DFN)) Q:DFN=""!(Y=0) D
.N NAME,DFNN,STATUS,DIV
.I FOR W ! D PB Q:Y=0
.S NAME=$P(DFN," ",1,$L(DFN," ")-1)
.S DFNN=$O(^DPT("B",NAME,0)) D
..Q:DFNN=""
..S STATUS=$S($D(^DPT(DFNN,.1)):"INPATIENT",1:"OUTPATIENT")
..S DIV=$$GET1^DIQ(2,DFNN,.19) I DIV="" S DIV="Unknown"
.S CNT=CNT+1
.I STATUS["IN" I FOR W !,CNT,") ",STATUS,", DIVISION:",DIV D PB Q:Y=0
.I STATUS["OU" I FOR W !,CNT,") ",STATUS D PB Q:Y=0
.I FOR W !,CNT,") ",IOUON,$P(DFN," ",1,$L(DFN," ")-1)," (",$P(DFN," ",$L(DFN," "))_")",IOUOFF,?48,"Total # Complete referrals: ",$G(^TMP("PXRMGEC",$J,"REFDFNN",$P(DFN," ",1,$L(DFN," ")-1))) D PB Q:Y=0
.S CNTREF="",REFNUM=0 F S CNTREF=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF)) Q:CNTREF=""!(Y=0) D
..I FOR W ! D PB Q:Y=0
..S REFNUM=REFNUM+1
..I FOR W !,IOUON,"Referral #"_REFNUM,IOUOFF D PB Q:Y=0
..S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE)) Q:DATE=""!(Y=0) D
...S VDT=0 F S VDT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT)) Q:VDT=""!(Y=0) D
....S CAT=0 F S CAT=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT)) Q:CAT=""!(Y=0) D
.....I FOR W !,?1,$P(CAT," ",3,6) D PB Q:Y=0
.....S DATEV=0 F S DATEV=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV)) Q:DATEV=""!(Y=0) D
......S DA=0 F S DA=$O(^TMP("PXRMGEC",$J,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV,DA)) Q:DA=""!(Y=0) D
.......S HFN=$$HFNAME(DA)
.......I FOR W !,?4,$P(HFN,"^",1),?44,$P(HFN,"^",2),?55,$P($$FMTE^XLFDT(DATEV,"5ZM"),"@",1)
.......I FOR D PB Q:Y=0
.......S COMMENT=$G(^AUPNVHF(DA,811))
.......I FOR I COMMENT'="" D COM^PXRMGECZ
.......I 'FOR W !,$P(DFN," ",1,$L(DFN," ")-1)_"^"_$P(DFN," ",$L(DFN," ")),"^",$P(CAT," ",3,6),"^",$P(HFN,"^",1),"^",$P(HFN,"^",2),"^",$P($$FMTE^XLFDT(DATEV,"5ZM"),"@",1),"^",REFNUM
K ^TMP("PXRMGEC",$J)
Q
;______
HFCD ;Health Factor Category Detailed
N CAT,HF,DATE,DFN,DFN1,FOR,HFDA,COMMENT
I FORMAT="D" S FOR=0
I FORMAT="F" S FOR=1
K ^TMP("PXRMGEC",$J,"HFCD")
D E^PXRMGECV("HFCD",1,BDT,EDT,"F",DFNONLY)
W @IOF
W "=============================================================================="
W !,"GEC Health Factor Category Detailed Report"
W !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
W !,"Complete and Incomplete Referrals"
I FOR W !,"Category"
I FOR W !,?2,"Patient Name"
I FOR W !,?4,"Health Factors",?45,$S($D(RPT7):"",1:"Value"),?52,"Date"
I 'FOR W !,"Category^Patient^SSN^Health Factor^"_$S($D(RPT7):"Date",1:"Value^Date")
W !,"=============================================================================="
D PB Q:Y=0
S CAT="" F S CAT=$O(^TMP("PXRMGEC",$J,"HFCD",CAT)) Q:CAT=""!(Y=0) D
.S DFN1=0
.I FOR W ! D PB Q:Y=0
.I FOR W !,IOUON,$P(CAT," ",3,6),IOUOFF D PB Q:Y=0
.S DFN=0 F S DFN=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN)) Q:DFN=""!(Y=0) D
..S HF="" F S HF=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,HF)) Q:HF=""!(Y=0) D
...S DATE=0 F S DATE=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,HF,DATE)) Q:DATE=""!(Y=0) D
....I FOR I DFN'=DFN1 W ! D PB Q:Y=0
....I FOR I DFN'=DFN1 W !,?2,$P($G(^DPT(DFN,0)),"^",1)_" ("_$P($G(^DPT(DFN,0)),"^",9)_")" D PB Q:Y=0 W ! D PB Q:Y=0 S DFN1=DFN
....S HFN=$$HFNAME(0,HF)
....S HFDA=$O(^TMP("PXRMGEC",$J,"HFCD",CAT,DFN,HF,DATE,0))
....I FOR W !,?4,$P(HFN,"^",1),?45,$S($D(RPT7):"",1:$P(HFN,"^",2)),?52,$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1)
....I FOR D PB Q:Y=0
....S COMMENT=$G(^AUPNVHF(HFDA,811))
....I FOR I COMMENT'="" D COM^PXRMGECZ
....I 'FOR W !,$P(CAT," ",3,5),"^",$P($G(^DPT(DFN,0)),"^",1)_"^"_$P($G(^DPT(DFN,0)),"^",9),"^",$P(HFN,"^",1),$S($D(RPT7):"",1:"^"_$P(HFN,"^",2)),"^",$P($$FMTE^XLFDT(DATE,"5ZM"),"@",1)
K ^TMP("PXRMGEC",$J)
D ^%ZISC
Q
;____
LOCCNT ;Count Locations of Referrals
N LOC,VDT
S LOC="" F S LOC=$O(^TMP("PXRMGEC",$J,"LOCB",LOC)) Q:LOC="" D
.S VDT="" F S VDT=$O(^TMP("PXRMGEC",$J,"LOCB",LOC,VDT)) Q:VDT="" D
..I $D(^TMP("PXRMGEC",$J,"LOCBB",LOC)) S ^TMP("PXRMGEC",$J,"LOCBB",LOC)=$G(^TMP("PXRMGEC",$J,"LOCBB",LOC))+1
..E S ^TMP("PXRMGEC",$J,"LOCBB",LOC)=1
Q
;
HFNAME(DA,NAME) ;Decide to split name into columns
N WHOLE,FIRST,SECOND,REF,REF2,RESULT
I DA>0 D
.S WHOLE=$P($G(^AUTTHF($P($G(^AUPNVHF(DA,0)),"^",1),0)),"^",1)
E S WHOLE=NAME
I $D(RPT7) D
.I WHOLE["(REFERRED TO)" D
..S WHOLE=$P(WHOLE," (",1)
S RESULT="^"
S REF="YESNOSTAGE 1STAGE 2STAGE 3STAGE 4"
S REF2="12"
S FIRST=$P(WHOLE,"-",1,$L(WHOLE,"-")-1)
S SECOND=$P(WHOLE,"-",$L(WHOLE,"-"))
I REF[SECOND S RESULT=FIRST_"^"_SECOND
E S RESULT=WHOLE_"^"
I REF2[SECOND S RESULT=WHOLE_"^"
Q RESULT
;=====
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
K DIR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECR 9144 printed Oct 16, 2024@17:46:40 Page 2
PXRMGECR ;SLC/JVS GEC-Reports ;7/14/05 10:44
+1 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
+2 QUIT
LOC ;Referrals by Location
+1 NEW CAT,HF,DATE,DFN,Y,HFN,DFNXX
+2 DO E^PXRMGECV("LOC",1,BDT,EDT,"F",0)
+3 IF FORMAT="F"
SET FOR=1
+4 IF FORMAT="D"
SET FOR=0
+5 WRITE @IOF
+6 WRITE "=============================================================================="
+7 WRITE !,"Complete GEC Referrals by Location"
+8 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+9 IF FOR
WRITE !,"Location"
+10 IF FOR
WRITE !,?5,"Patient",?50,"Finish Date"
+11 IF 'FOR
WRITE !,"Location^Location Count^Patient^SSN^Finish Date"
+12 WRITE !,"=============================================================================="
+13 WRITE !
DO PB
if Y=0
QUIT
+14 SET LOCN=""
FOR
SET LOCN=$ORDER(^TMP("PXRMGEC",$JOB,"TMPLOC",LOCN))
if LOCN=""!(Y=0)
QUIT
Begin DoDot:1
+15 if LOCNP'=1&(LOCN'=LOCNP)
QUIT
+16 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+17 IF FOR
WRITE !,IOUON,LOCN,IOUOFF,?30,"Total # Patients Evaluated= ",$GET(^TMP("PXRMGEC",$JOB,"REFLOCC",LOCN))
DO PB
if Y=0
QUIT
+18 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+19 SET DFNXX=""
FOR
SET DFNXX=$ORDER(^TMP("PXRMGEC",$JOB,"TMPLOC",LOCN,DFNXX))
if DFNXX=""!(Y=0)
QUIT
Begin DoDot:2
+20 SET VDT=0
FOR
SET VDT=$ORDER(^TMP("PXRMGEC",$JOB,"TMPLOC",LOCN,DFNXX,VDT))
if VDT=""!(Y=0)
QUIT
Begin DoDot:3
+21 IF VDT["0000"
IF FOR
WRITE !,?5,DFNXX,?50,"Incomplete"
+22 IF '$TEST
IF FOR
WRITE !,?5,$PIECE(DFNXX," ",1,$LENGTH(DFNXX," ")-1)," ("_$PIECE(DFNXX," ",$LENGTH(DFNXX," "))_")",?50,$PIECE($$FMTE^XLFDT(VDT,"5ZM"),"@",1)
+23 IF FOR
DO PB
if Y=0
QUIT
+24 IF 'FOR
WRITE !,LOCN,"^",$GET(^TMP("PXRMGEC",$JOB,"REFLOCC",LOCN)),"^",$PIECE(DFNXX," ",1,$LENGTH(DFNXX," ")-1),"^",$PIECE(DFNXX," ",$LENGTH(DFNXX," ")),"^",$PIECE($$FMTE^XLFDT(VDT,"5ZM"),"@",1)
End DoDot:3
End DoDot:2
End DoDot:1
+25 KILL ^TMP("PXRMGEC",$JOB)
+26 QUIT
+27 ;_______
DR ;Referrals by Date Range
+1 NEW CAT,HF,DATE,DFN,Y,HFN,CNTREF,DIF,DIFF
+2 DO E^PXRMGECV("HS1",INC,BDT,EDT,$SELECT(INC=1:"F",1:"S"),DFNONLY)
+3 IF FORMAT="D"
SET FOR=0
+4 IF FORMAT="F"
SET FOR=1
+5 WRITE @IOF
+6 WRITE "=============================================================================="
+7 WRITE !,"Complete and/or Incomplete GEC Referrals by Date Range"
+8 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+9 WRITE !,$SELECT(INC=0:"Incomplete",INC=1:"Complete",INC=2:"Complete and Incomplete",1:"")_" Referrals"
+10 IF FOR
WRITE !,"Patient"
+11 IF INC=1
IF FOR
WRITE !,?5,"Start Date",?20,"Finished",?35,"Elapsed Time"
+12 IF '$TEST
IF FOR
WRITE !,?5,"Start Date",?20,"Finished",?35,"Elapsed Time",?50,"Incomplete Status"
+13 IF 'FOR
WRITE !,"Patient^SS#^Count^Start Date^Finished Date^Elapsed Time"
+14 WRITE !,"=============================================================================="
+15 WRITE !
DO PB
if Y=0
QUIT
+16 SET DFN=""
FOR
SET DFN=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN))
if DFN=""!(Y=0)
QUIT
Begin DoDot:1
+17 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+18 IF FOR
WRITE !,IOUON,$PIECE(DFN," ",1,$LENGTH(DFN," ")-1)," ("_$PIECE(DFN," ",$LENGTH(DFN," "))_")"," ",IOUOFF
+19 IF FOR
WRITE ?44,$GET(^TMP("PXRMGEC",$JOB,"REFDFNN",$PIECE(DFN," ",1,($LENGTH(DFN," ")-1))))," Referral(s)"
DO PB
if Y=0
QUIT
+20 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+21 SET CNTREF=""
FOR
SET CNTREF=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF))
if CNTREF=""!(Y=0)
QUIT
Begin DoDot:2
+22 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE))
if DATE=""!(Y=0)
QUIT
Begin DoDot:3
+23 SET VDT=0
FOR
SET VDT=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT))
if VDT=""!(Y=0)
QUIT
Begin DoDot:4
+24 SET DIFF=""
IF VDT>0
SET DIFF=$$FMDIFF^XLFDT(VDT,DATE,1)+1
+25 SET DIF=""
SET DIF=$$FMDIFF^XLFDT(DT,DATE,1)+1
+26 IF VDT["0000"
IF FOR
WRITE !,?5,$PIECE($$FMTE^XLFDT(DATE,"5ZM"),"@",1),?20,"",?35,$SELECT(DIFF="":DIF_" Days",DIFF>0:DIFF_" Days",1:""),?50,$SELECT(DIFF="":"Incomplete",1:"")
+27 IF '$TEST
IF FOR
WRITE !,?5,$PIECE($$FMTE^XLFDT(DATE,"5ZM"),"@",1),?20,$PIECE($$FMTE^XLFDT(VDT,"5ZM"),"@",1),?35,$SELECT(DIFF="":DIF_" Days",DIFF>0:DIFF_" Days",1:""),?50,$SELECT(DIFF="":"Incomplete",1:"")
+28 IF FOR
DO PB
if Y=0
QUIT
+29 IF 'FOR
WRITE !,$PIECE(DFN," ",1,$LENGTH(DFN," ")-1),"^",$PIECE(DFN," ",$LENGTH(DFN," ")),"^"
+30 IF 'FOR
WRITE $GET(^TMP("PXRMGEC",$JOB,"REFDFNN",$PIECE(DFN," ",1,$LENGTH(DFN," ")-1))),"^",$PIECE($$FMTE^XLFDT(DATE,"5ZM"),"@",1),"^",$PIECE($$FMTE^XLFDT(VDT,"5ZM"),"@",1),"^",$SELECT(DIFF="":DIF,DIFF>0:DIFF,1:"")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 KILL ^TMP("PXRMGEC",$JOB)
+32 QUIT
+33 ;_____
HS1 ;By Patient
+1 NEW CAT,HF,DATE,DFN,Y,HFN,CNTREF,X,REFNUM,CNT,STATUS,NAME,DIV
+2 DO E^PXRMGECV("HS1",1,BDT,EDT,"F",DFNONLY)
+3 IF FORMAT="D"
SET FOR=0
+4 IF FORMAT="F"
SET FOR=1
+5 WRITE @IOF
+6 WRITE "=============================================================================="
+7 WRITE !,"GEC Patient"
+8 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+9 IF FOR
WRITE !,"Patient"
+10 IF FOR
WRITE !," Category"
+11 IF FOR
WRITE !," Health Factor",?44,"Value",?55,"Date of Evaluation"
+12 IF 'FOR
WRITE !,"Patient^Category^Health Factor^Value^Date of Evaluation"
+13 WRITE !,"=============================================================================="
+14 SET CNT=0
+15 SET Y=1
+16 SET DFN=""
FOR
SET DFN=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN))
if DFN=""!(Y=0)
QUIT
Begin DoDot:1
+17 NEW NAME,DFNN,STATUS,DIV
+18 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+19 SET NAME=$PIECE(DFN," ",1,$LENGTH(DFN," ")-1)
+20 SET DFNN=$ORDER(^DPT("B",NAME,0))
Begin DoDot:2
+21 if DFNN=""
QUIT
+22 SET STATUS=$SELECT($DATA(^DPT(DFNN,.1)):"INPATIENT",1:"OUTPATIENT")
+23 SET DIV=$$GET1^DIQ(2,DFNN,.19)
IF DIV=""
SET DIV="Unknown"
End DoDot:2
+24 SET CNT=CNT+1
+25 IF STATUS["IN"
IF FOR
WRITE !,CNT,") ",STATUS,", DIVISION:",DIV
DO PB
if Y=0
QUIT
+26 IF STATUS["OU"
IF FOR
WRITE !,CNT,") ",STATUS
DO PB
if Y=0
QUIT
+27 IF FOR
WRITE !,CNT,") ",IOUON,$PIECE(DFN," ",1,$LENGTH(DFN," ")-1)," (",$PIECE(DFN," ",$LENGTH(DFN," "))_")",IOUOFF,?48,"Total # Complete referrals: ",$GET(^TMP("PXRMGEC",$JOB,"REFDFNN",$PIECE(DFN," ",1,$LENGTH(DFN," ")-1)))
DO PB
if Y=0
QUIT
+28 SET CNTREF=""
SET REFNUM=0
FOR
SET CNTREF=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF))
if CNTREF=""!(Y=0)
QUIT
Begin DoDot:2
+29 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+30 SET REFNUM=REFNUM+1
+31 IF FOR
WRITE !,IOUON,"Referral #"_REFNUM,IOUOFF
DO PB
if Y=0
QUIT
+32 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE))
if DATE=""!(Y=0)
QUIT
Begin DoDot:3
+33 SET VDT=0
FOR
SET VDT=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT))
if VDT=""!(Y=0)
QUIT
Begin DoDot:4
+34 SET CAT=0
FOR
SET CAT=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT,CAT))
if CAT=""!(Y=0)
QUIT
Begin DoDot:5
+35 IF FOR
WRITE !,?1,$PIECE(CAT," ",3,6)
DO PB
if Y=0
QUIT
+36 SET DATEV=0
FOR
SET DATEV=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV))
if DATEV=""!(Y=0)
QUIT
Begin DoDot:6
+37 SET DA=0
FOR
SET DA=$ORDER(^TMP("PXRMGEC",$JOB,"HS1",DFN,CNTREF,DATE,VDT,CAT,DATEV,DA))
if DA=""!(Y=0)
QUIT
Begin DoDot:7
+38 SET HFN=$$HFNAME(DA)
+39 IF FOR
WRITE !,?4,$PIECE(HFN,"^",1),?44,$PIECE(HFN,"^",2),?55,$PIECE($$FMTE^XLFDT(DATEV,"5ZM"),"@",1)
+40 IF FOR
DO PB
if Y=0
QUIT
+41 SET COMMENT=$GET(^AUPNVHF(DA,811))
+42 IF FOR
IF COMMENT'=""
DO COM^PXRMGECZ
+43 IF 'FOR
WRITE !,$PIECE(DFN," ",1,$LENGTH(DFN," ")-1)_"^"_$PIECE(DFN," ",$LENGTH(DFN," ")),"^",$PIECE(CAT," ",3,6),"^",$PIECE(HFN,"^",1),"^",$PIECE(HFN,"^",2),"^",$PIECE($$FMTE^XLFDT(DATEV,"5ZM
"),"@",1),"^",REFNUM
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+44 KILL ^TMP("PXRMGEC",$JOB)
+45 QUIT
+46 ;______
HFCD ;Health Factor Category Detailed
+1 NEW CAT,HF,DATE,DFN,DFN1,FOR,HFDA,COMMENT
+2 IF FORMAT="D"
SET FOR=0
+3 IF FORMAT="F"
SET FOR=1
+4 KILL ^TMP("PXRMGEC",$JOB,"HFCD")
+5 DO E^PXRMGECV("HFCD",1,BDT,EDT,"F",DFNONLY)
+6 WRITE @IOF
+7 WRITE "=============================================================================="
+8 WRITE !,"GEC Health Factor Category Detailed Report"
+9 WRITE !,"From: "_$$FMTE^XLFDT(BDT,"5ZM")_" To: "_$$FMTE^XLFDT(EDT,"5ZM")
+10 WRITE !,"Complete and Incomplete Referrals"
+11 IF FOR
WRITE !,"Category"
+12 IF FOR
WRITE !,?2,"Patient Name"
+13 IF FOR
WRITE !,?4,"Health Factors",?45,$SELECT($DATA(RPT7):"",1:"Value"),?52,"Date"
+14 IF 'FOR
WRITE !,"Category^Patient^SSN^Health Factor^"_$SELECT($DATA(RPT7):"Date",1:"Value^Date")
+15 WRITE !,"=============================================================================="
+16 DO PB
if Y=0
QUIT
+17 SET CAT=""
FOR
SET CAT=$ORDER(^TMP("PXRMGEC",$JOB,"HFCD",CAT))
if CAT=""!(Y=0)
QUIT
Begin DoDot:1
+18 SET DFN1=0
+19 IF FOR
WRITE !
DO PB
if Y=0
QUIT
+20 IF FOR
WRITE !,IOUON,$PIECE(CAT," ",3,6),IOUOFF
DO PB
if Y=0
QUIT
+21 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("PXRMGEC",$JOB,"HFCD",CAT,DFN))
if DFN=""!(Y=0)
QUIT
Begin DoDot:2
+22 SET HF=""
FOR
SET HF=$ORDER(^TMP("PXRMGEC",$JOB,"HFCD",CAT,DFN,HF))
if HF=""!(Y=0)
QUIT
Begin DoDot:3
+23 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("PXRMGEC",$JOB,"HFCD",CAT,DFN,HF,DATE))
if DATE=""!(Y=0)
QUIT
Begin DoDot:4
+24 IF FOR
IF DFN'=DFN1
WRITE !
DO PB
if Y=0
QUIT
+25 IF FOR
IF DFN'=DFN1
WRITE !,?2,$PIECE($GET(^DPT(DFN,0)),"^",1)_" ("_$PIECE($GET(^DPT(DFN,0)),"^",9)_")"
DO PB
if Y=0
QUIT
WRITE !
DO PB
if Y=0
QUIT
SET DFN1=DFN
+26 SET HFN=$$HFNAME(0,HF)
+27 SET HFDA=$ORDER(^TMP("PXRMGEC",$JOB,"HFCD",CAT,DFN,HF,DATE,0))
+28 IF FOR
WRITE !,?4,$PIECE(HFN,"^",1),?45,$SELECT($DATA(RPT7):"",1:$PIECE(HFN,"^",2)),?52,$PIECE($$FMTE^XLFDT(DATE,"5ZM"),"@",1)
+29 IF FOR
DO PB
if Y=0
QUIT
+30 SET COMMENT=$GET(^AUPNVHF(HFDA,811))
+31 IF FOR
IF COMMENT'=""
DO COM^PXRMGECZ
+32 IF 'FOR
WRITE !,$PIECE(CAT," ",3,5),"^",$PIECE($GET(^DPT(DFN,0)),"^",1)_"^"_$PIECE($GET(^DPT(DFN,0)),"^",9),"^",$PIECE(HFN,"^",1),$SELECT($DATA(RPT7):"",1:"^"_$PIECE(HFN,"^",2)),"^",$PIECE($$FMTE^XLFDT(DATE,"5ZM"),"@
",1)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+33 KILL ^TMP("PXRMGEC",$JOB)
+34 DO ^%ZISC
+35 QUIT
+36 ;____
LOCCNT ;Count Locations of Referrals
+1 NEW LOC,VDT
+2 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("PXRMGEC",$JOB,"LOCB",LOC))
if LOC=""
QUIT
Begin DoDot:1
+3 SET VDT=""
FOR
SET VDT=$ORDER(^TMP("PXRMGEC",$JOB,"LOCB",LOC,VDT))
if VDT=""
QUIT
Begin DoDot:2
+4 IF $DATA(^TMP("PXRMGEC",$JOB,"LOCBB",LOC))
SET ^TMP("PXRMGEC",$JOB,"LOCBB",LOC)=$GET(^TMP("PXRMGEC",$JOB,"LOCBB",LOC))+1
+5 IF '$TEST
SET ^TMP("PXRMGEC",$JOB,"LOCBB",LOC)=1
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
HFNAME(DA,NAME) ;Decide to split name into columns
+1 NEW WHOLE,FIRST,SECOND,REF,REF2,RESULT
+2 IF DA>0
Begin DoDot:1
+3 SET WHOLE=$PIECE($GET(^AUTTHF($PIECE($GET(^AUPNVHF(DA,0)),"^",1),0)),"^",1)
End DoDot:1
+4 IF '$TEST
SET WHOLE=NAME
+5 IF $DATA(RPT7)
Begin DoDot:1
+6 IF WHOLE["(REFERRED TO)"
Begin DoDot:2
+7 SET WHOLE=$PIECE(WHOLE," (",1)
End DoDot:2
End DoDot:1
+8 SET RESULT="^"
+9 SET REF="YESNOSTAGE 1STAGE 2STAGE 3STAGE 4"
+10 SET REF2="12"
+11 SET FIRST=$PIECE(WHOLE,"-",1,$LENGTH(WHOLE,"-")-1)
+12 SET SECOND=$PIECE(WHOLE,"-",$LENGTH(WHOLE,"-"))
+13 IF REF[SECOND
SET RESULT=FIRST_"^"_SECOND
+14 IF '$TEST
SET RESULT=WHOLE_"^"
+15 IF REF2[SECOND
SET RESULT=WHOLE_"^"
+16 QUIT RESULT
+17 ;=====
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
End DoDot:1
+7 KILL DIR
+8 QUIT
+9 ;
