- 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 Feb 18, 2025@23:12:11 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 ;
