VistA-WorldVistAEHR/r/HEALTH_SUMMARY-GMTS/GMTSGEC.m

68 lines
2.6 KiB
Mathematica

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