- 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 Mar 13, 2025@21:02:14 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
