GMTSGEC ; SLC/AGP - Ad Hoc Summary Driver ; 07/11/2007
;;2.7;Health Summary;**63,39,87**;Oct 20, 1995;Build 23
;
; DBIA 1268 ^AUTTHF(
;
EN(X) ;
I $P($G(^GMT(142.1,+$G(CMP),0)),U,4)="GECH" Q "I (($P(^(0),U,10)=""C"")&(+$P(^(0),U,11)'=1))&($E($P($G(^(0)),U,9),1,3)=""GEC"")"
Q "I $P(^(0),U,11)'=1"
;
REPORT ;
N CNT
D CKP^GMTSUP Q:$D(GMTSQIT)
S CNT=0 F S CNT=$O(^TMP("GMTSGEC",$J,CNT)) Q:CNT="" D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,$G(^TMP("GMTSGEC",$J,CNT))
Q
;
REPHEAD ;
N STR
S STR="Total Number of Completed Referrals in date range: "_CNT1
S ^TMP("GMTSGEC",$J,2)=STR
Q
;
PRINT ;
N ACNT,ACNT1,BDT,CNT,CNT1,EDT,EDT1,GMTSGECH,INCOMP,OCCCNT,VALUE
N EHF,EVDT,HF,HFCAT,VDT
K ^TMP("PXRMGEC",$J,"HS")
K ^TMP("GMTSGEC",$J)
I $G(GMTSNDM)<1 S OCCCNT=1
E S OCCCNT=GMTSNDM
D E^PXRMGECV("HS",1,$G(GMTSBEG),$G(GMTSEND),"S",$G(DFN))
S (BDT,CNT,EDT,VALUE)="",CNT1=0,ACNT=2
F S CNT=$O(^TMP("PXRMGEC",$J,"HS",CNT),-1) Q:CNT=""!($G(CNT1)=OCCCNT) D
.I VALUE'=CNT S VALUE=CNT,CNT1=CNT1+1,INCOMP=0
.F S BDT=$O(^TMP("PXRMGEC",$J,"HS",CNT,DFN,BDT)) Q:BDT="" D
..F S EDT=$O(^TMP("PXRMGEC",$J,"HS",CNT,DFN,BDT,EDT)) Q:EDT="" D
...S EDT1=EDT I EDT="0000000" S EDT1=DT,INCOMP=1
...S ACNT=ACNT+1,^TMP("GMTSGEC",$J,ACNT)="",ACNT=ACNT+1
...S STR=$$LJ^XLFSTR(" ",3),STR=STR_"Referral Number: "_CNT1
...S ^TMP("GMTSGEC",$J,ACNT)=STR,ACNT=ACNT+1,STR=$$LJ^XLFSTR(" ",5)
...S STR=STR_$$LJ^XLFSTR("START DATE",30),STR=STR_"END DATE"
...S ACNT=ACNT+1,^TMP("GMTSGEC",$J,ACNT)=STR,ACNT=ACNT+1
...S STR=$$LJ^XLFSTR(" ",5),STR=STR_$$LJ^XLFSTR($$FMTE^XLFDT(BDT),30)
...I INCOMP=0 S STR=STR_$$FMTE^XLFDT(EDT)
...I INCOMP=1 S STR=STR_"Incomplete Referral"
...S ^TMP("GMTSGEC",$J,ACNT)=STR,ACNT=ACNT+1
...S ^TMP("GMTSGEC",$J,ACNT)=" ",ACNT=ACNT+1,STR=$$LJ^XLFSTR(" ",10)
...S ^TMP("GMTSGEC",$J,ACNT)=STR_"Category",ACNT=ACNT+1
...S STR=$$LJ^XLFSTR(" ",15),STR=STR_$$LJ^XLFSTR("Health Factor",40)
...S STR=STR_"Visit Date",^TMP("GMTSGEC",$J,ACNT)=STR,ACNT=ACNT+1
...S ^TMP("GMTSGEC",$J,ACNT)=" ",ACNT=ACNT+1,HFCAT=""
...F S HFCAT=$O(^TMP("PXRMGEC",$J,"HS",CNT,DFN,BDT,EDT,HFCAT)) Q:HFCAT="" D
....S STR=$$LJ^XLFSTR(" ",10)
....S ^TMP("GMTSGEC",$J,ACNT)=STR_HFCAT,ACNT=ACNT+1,VDT=""
....F S VDT=$O(^TMP("PXRMGEC",$J,"HS",CNT,DFN,BDT,EDT,HFCAT,VDT)) Q:VDT="" D
.....S EVDT=$$FMTE^XLFDT(VDT),HF=""
.....F S HF=$O(^TMP("PXRMGEC",$J,"HS",CNT,DFN,BDT,EDT,HFCAT,VDT,HF)) Q:HF="" D
......S EHF=$$GET1^DIQ(9999999.64,$P($G(^AUPNVHF(HF,0)),U),.01)
......S STR=$$LJ^XLFSTR(" ",15)
......S STR=STR_$$LJ^XLFSTR(EHF,40)
......S STR=STR_$$LJ^XLFSTR(EVDT,25)
......S ^TMP("GMTSGEC",$J,ACNT)=STR,ACNT=ACNT+1
D REPHEAD
D REPORT
K ^TMP("GMTSGEC",$J)
K ^TMP("PXRMGEC",$J,"HS")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSGEC 2777 printed Nov 22, 2024@17:07:43 Page 2
GMTSGEC ; SLC/AGP - Ad Hoc Summary Driver ; 07/11/2007
+1 ;;2.7;Health Summary;**63,39,87**;Oct 20, 1995;Build 23
+2 ;
+3 ; DBIA 1268 ^AUTTHF(
+4 ;
EN(X) ;
+1 IF $PIECE($GET(^GMT(142.1,+$GET(CMP),0)),U,4)="GECH"
QUIT "I (($P(^(0),U,10)=""C"")&(+$P(^(0),U,11)'=1))&($E($P($G(^(0)),U,9),1,3)=""GEC"")"
+2 QUIT "I $P(^(0),U,11)'=1"
+3 ;
REPORT ;
+1 NEW CNT
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("GMTSGEC",$JOB,CNT))
if CNT=""
QUIT
Begin DoDot:1
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE !,$GET(^TMP("GMTSGEC",$JOB,CNT))
End DoDot:1
+6 QUIT
+7 ;
REPHEAD ;
+1 NEW STR
+2 SET STR="Total Number of Completed Referrals in date range: "_CNT1
+3 SET ^TMP("GMTSGEC",$JOB,2)=STR
+4 QUIT
+5 ;
PRINT ;
+1 NEW ACNT,ACNT1,BDT,CNT,CNT1,EDT,EDT1,GMTSGECH,INCOMP,OCCCNT,VALUE
+2 NEW EHF,EVDT,HF,HFCAT,VDT
+3 KILL ^TMP("PXRMGEC",$JOB,"HS")
+4 KILL ^TMP("GMTSGEC",$JOB)
+5 IF $GET(GMTSNDM)<1
SET OCCCNT=1
+6 IF '$TEST
SET OCCCNT=GMTSNDM
+7 DO E^PXRMGECV("HS",1,$GET(GMTSBEG),$GET(GMTSEND),"S",$GET(DFN))
+8 SET (BDT,CNT,EDT,VALUE)=""
SET CNT1=0
SET ACNT=2
+9 FOR
SET CNT=$ORDER(^TMP("PXRMGEC",$JOB,"HS",CNT),-1)
if CNT=""!($GET(CNT1)=OCCCNT)
QUIT
Begin DoDot:1
+10 IF VALUE'=CNT
SET VALUE=CNT
SET CNT1=CNT1+1
SET INCOMP=0
+11 FOR
SET BDT=$ORDER(^TMP("PXRMGEC",$JOB,"HS",CNT,DFN,BDT))
if BDT=""
QUIT
Begin DoDot:2
+12 FOR
SET EDT=$ORDER(^TMP("PXRMGEC",$JOB,"HS",CNT,DFN,BDT,EDT))
if EDT=""
QUIT
Begin DoDot:3
+13 SET EDT1=EDT
IF EDT="0000000"
SET EDT1=DT
SET INCOMP=1
+14 SET ACNT=ACNT+1
SET ^TMP("GMTSGEC",$JOB,ACNT)=""
SET ACNT=ACNT+1
+15 SET STR=$$LJ^XLFSTR(" ",3)
SET STR=STR_"Referral Number: "_CNT1
+16 SET ^TMP("GMTSGEC",$JOB,ACNT)=STR
SET ACNT=ACNT+1
SET STR=$$LJ^XLFSTR(" ",5)
+17 SET STR=STR_$$LJ^XLFSTR("START DATE",30)
SET STR=STR_"END DATE"
+18 SET ACNT=ACNT+1
SET ^TMP("GMTSGEC",$JOB,ACNT)=STR
SET ACNT=ACNT+1
+19 SET STR=$$LJ^XLFSTR(" ",5)
SET STR=STR_$$LJ^XLFSTR($$FMTE^XLFDT(BDT),30)
+20 IF INCOMP=0
SET STR=STR_$$FMTE^XLFDT(EDT)
+21 IF INCOMP=1
SET STR=STR_"Incomplete Referral"
+22 SET ^TMP("GMTSGEC",$JOB,ACNT)=STR
SET ACNT=ACNT+1
+23 SET ^TMP("GMTSGEC",$JOB,ACNT)=" "
SET ACNT=ACNT+1
SET STR=$$LJ^XLFSTR(" ",10)
+24 SET ^TMP("GMTSGEC",$JOB,ACNT)=STR_"Category"
SET ACNT=ACNT+1
+25 SET STR=$$LJ^XLFSTR(" ",15)
SET STR=STR_$$LJ^XLFSTR("Health Factor",40)
+26 SET STR=STR_"Visit Date"
SET ^TMP("GMTSGEC",$JOB,ACNT)=STR
SET ACNT=ACNT+1
+27 SET ^TMP("GMTSGEC",$JOB,ACNT)=" "
SET ACNT=ACNT+1
SET HFCAT=""
+28 FOR
SET HFCAT=$ORDER(^TMP("PXRMGEC",$JOB,"HS",CNT,DFN,BDT,EDT,HFCAT))
if HFCAT=""
QUIT
Begin DoDot:4
+29 SET STR=$$LJ^XLFSTR(" ",10)
+30 SET ^TMP("GMTSGEC",$JOB,ACNT)=STR_HFCAT
SET ACNT=ACNT+1
SET VDT=""
+31 FOR
SET VDT=$ORDER(^TMP("PXRMGEC",$JOB,"HS",CNT,DFN,BDT,EDT,HFCAT,VDT))
if VDT=""
QUIT
Begin DoDot:5
+32 SET EVDT=$$FMTE^XLFDT(VDT)
SET HF=""
+33 FOR
SET HF=$ORDER(^TMP("PXRMGEC",$JOB,"HS",CNT,DFN,BDT,EDT,HFCAT,VDT,HF))
if HF=""
QUIT
Begin DoDot:6
+34 SET EHF=$$GET1^DIQ(9999999.64,$PIECE($GET(^AUPNVHF(HF,0)),U),.01)
+35 SET STR=$$LJ^XLFSTR(" ",15)
+36 SET STR=STR_$$LJ^XLFSTR(EHF,40)
+37 SET STR=STR_$$LJ^XLFSTR(EVDT,25)
+38 SET ^TMP("GMTSGEC",$JOB,ACNT)=STR
SET ACNT=ACNT+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 DO REPHEAD
+40 DO REPORT
+41 KILL ^TMP("GMTSGEC",$JOB)
+42 KILL ^TMP("PXRMGEC",$JOB,"HS")
+43 QUIT
