Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTFRU1

DGPTFRU1.m

Go to the documentation of this file. 
  1. DGPTFRU1 ; ALB/SCK - PTF RECORDS CLOSEOUT RPT FOR MT INDICATOR = U ; 21 JULY 2003
  1.  ;;5.3;Registration;**537**;Aug 13, 1993
  1.  ;
  1. EN ; Main entry point for report
  1.  N DIR,DIRUT,DGBEG,DGEND,RSLT,Y,X
  1.  ;
  1.  S DIR("A")="Please Select Date Range for patient discharges",DIR(0)="SM^A:Previous Fiscal Year;B:Current Fiscal Year;O:Other Date Range"
  1.  S DIR("B")="B"
  1.  S DIR("?")="You may select either the previous fiscal year (A) or the current fiscal year (B) for the date range.  Select (O) if you choose to specify your own date range."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S RSLT=Y
  1.  ;
  1.  I RSLT="A" D 
  1.  . D PASTYR(.DGBEG,.DGEND)
  1.  E  I RSLT="B" D
  1.  . D CURYR(.DGBEG,.DGEND)
  1.  E  D
  1.  . D GETDT(.DGBEG,.DGEND)
  1.  Q:'$G(DGBEG)!('$G(DGEND))
  1.  W !!?3,"Date Range: "_$$FMTE^XLFDT(DGBEG)_" to "_$$FMTE^XLFDT(DGEND)
  1.  ;
  1.  N X,Y,IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  W:$D(IORVON) IORVON
  1.  W !,"A 132-Column printer is required for this report."
  1.  W !,"This report will NOT print correctly to the screen!"
  1.  W:$D(IORVOFF) IORVOFF
  1.  ;
  1.  N ZTSAVE,ZTRTN,ZTDESC,POP,%ZIS,ZTQUEUED
  1.  S %ZIS="Q" D ^%ZIS G:POP EXIT
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTSAVE("DGBEG")="",ZTSAVE("DGEND")="",ZTSAVE("DUZ")=""
  1.  . S ZTRTN="RUN^DGPTFRU1"
  1.  . S ZTDESC="PTF CLOSEOUT MT=U RPT"
  1.  . D ^%ZTLOAD D HOME^%ZIS K IO("Q")
  1.  D RUN
  1.  D ^%ZISC
  1. EXIT S:$D(ZTQUEUED) ZTREQ="@" Q
  1.  ;
  1. RUN ; Run report
  1.  U IO
  1.  K ^TMP("DGPTFRU",$J),^TMP("DGPTFRUS",$J)
  1.  ;
  1.  D BLD(DGBEG,DGEND)
  1.  D CHKMT
  1.  D SRTNAME
  1.  D PRINT
  1.  D MAIL
  1.  K ^TMP("DGPTFRU",$J),^TMP("DGPTFRUS",$J)
  1.  Q
  1.  ;
  1. PASTYR(DGBEG,DGEND) ; Set dates for previous fiscal year
  1.  N CURYR,PRVYR,CURMN,%I
  1.  ;
  1.  ; Input/Output - See GETDT
  1.  ;
  1.  D NOW^%DTC
  1.  S CURYR=%I(3),CURMN=%I(1)
  1.  I CURMN>9 D
  1.  . S CURYR=CURYR+1
  1.  S PRVYR=CURYR-1
  1.  S DGEND=$$FMADD^XLFDT(PRVYR_"1001",-1)
  1.  S DGBEG=$$FMADD^XLFDT(PRVYR_"1001",-365)
  1.  Q
  1.  ;
  1. CURYR(DGBEG,DGEND) ; Set dates for current fiscal year
  1.  N CURYR,CURMN,%I
  1.  ;
  1.  ; Input/Output - See GETDT
  1.  ;
  1.  D NOW^%DTC
  1.  S CURYR=%I(3),CURMN=%I(1)
  1.  I CURMN<10 D
  1.  . S CURYR=CURYR-1
  1.  S DGBEG=CURYR_"1001"
  1.  S DGEND=$P($$NOW^XLFDT,".")
  1.  Q
  1.  ;
  1. GETDT(DGBEG,DGEND) ;  Get beginning and ending date for search
  1.  ; Output   DGBEG   Beginning for date range, passed in by reference
  1.  ;          DGEND   End of date range, passed in by reference
  1.  ;          result  1 - If function successful
  1.  ;                  0 - If function NOT successful (User quit)
  1.  ;
  1.  N DIR,DIRUT,Y
  1.  ;
  1.  W !!?3,"You have selected to specify your own date range.  Please note that by"
  1.  W !?3,"doing so you may not generate an accurate picture of the transmitted PTF"
  1.  W !?3,"closeouts where the means test indicator equals 'U'.",!
  1.  ;
  1.  S DIR(0)="DAO^:DT:EX"
  1.  S DIR("A")="Beginning Date: "
  1.  S DIR("?")="^D HELP^%DTC"
  1.  D ^DIR
  1.  I $D(DIRUT) D  Q
  1.  . S DGBEG=0
  1.  S DGBEG=Y
  1.  ;
  1.  S DIR(0)="DAO^:DT:EX"
  1.  S DIR("A")="Ending Date: "
  1.  D ^DIR
  1.  I $D(DIRUT) D  Q
  1.  . S DGEND=0
  1.  S DGEND=Y
  1.  Q
  1.  ;
  1. BLD(DGBEG,DGEND) ;  Build list of PTF records for discharge date range
  1.  N DGX,DGMAX,CNT,DGPIEN,DFN
  1.  ;
  1.  ;  Input/Output - See GETDT
  1.  ;
  1.  S DGX=$$FMADD^XLFDT(DGBEG,0,0,0,-1) ; set inital search DT to beginning date minus one second
  1.  S DGMAX=$$FMADD^XLFDT(DGEND,0,23,59,59) ; set search end date to end date plus one day
  1.  ;
  1.  S ^TMP("DGPTFRU",$J,0,"BEGIN")=$H
  1.  F  S DGX=$O(^DGPT("ADS",DGX)) Q:'DGX  D  Q:DGX>DGMAX  ; Search PTF Discharge Dates
  1.  . S DGPIEN=0
  1.  . F  S DGPIEN=$O(^DGPT("ADS",DGX,DGPIEN)) Q:'DGPIEN  D
  1.  . . S DFN=$P($G(^DGPT(DGPIEN,0)),U,1)
  1.  . . Q:'DFN
  1.  . . S ^TMP("DGPTFRU",$J,DFN,DGPIEN)=DGX_U_$$GET1^DIQ(45,DGPIEN,10,"I")_U_+$P($G(^DGPT(DGPIEN,0)),U,11)
  1.  . . S ^TMP("DGPTFRU",$J,0,"CNT")=$G(^TMP("DGPTFRU",$J,0,"CNT"))+1
  1.  S ^TMP("DGPTFRU",$J,0,"END")=$H
  1.  Q
  1.  ;
  1. CHKMT ; Clean out all PTF records except those meeting the MT=U conditions
  1.  N DFN,DGPIEN,DGIND
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP("DGPTFRU",$J,DFN)) Q:'DFN  D
  1.  . S DGPIEN=0
  1.  . F  S DGPIEN=$O(^TMP("DGPTFRU",$J,DFN,DGPIEN)) Q:'DGPIEN  D
  1.  . . S DGIND=$P($G(^TMP("DGPTFRU",$J,DFN,DGPIEN)),U,2)
  1.  . . ; If the MT INDICATOR of any of the closeout records for the patient is a value other than 'U', then delete all the entries for the patient
  1.  . . I DGIND'="U" D  Q
  1.  . . . K ^TMP("DGPTFRU",$J,DFN)
  1.  S ^TMP("DGPTFRU",$J,0,"END")=$H
  1.  Q
  1.  ;
  1. SRTNAME ; Sort remaining PTF records by patient name and discharge date
  1.  N DFN,DGNAME,DGPIEN,DGPDT
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP("DGPTFRU",$J,DFN)) Q:'DFN  D
  1.  . S DGNAME=$$GET1^DIQ(2,DFN,.01)
  1.  . Q:DGNAME']""
  1.  . S ^TMP("DGPTFRU",$J,0,"PATCNT")=$G(^TMP("DGPTFRU",$J,0,"PATCNT"))+1
  1.  . S DGPIEN=0
  1.  . F  S DGPIEN=$O(^TMP("DGPTFRU",$J,DFN,DGPIEN)) Q:'DGPIEN  D
  1.  . . S ^TMP("DGPTFRUS",$J,DGNAME,DGPIEN)=DFN_U_$P($G(^TMP("DGPTFRU",$J,DFN,DGPIEN)),U,3)
  1.  . . S ^TMP("DGPTFRU",$J,0,"FINAL CNT")=$G(^TMP("DGPTFRU",$J,0,"FINAL CNT"))+1
  1.  S ^TMP("DGPTFRU",$J,0,"END")=$H
  1.  Q
  1.  ;
  1. MAIL ; send message with report statistics
  1.  N MSG,XMSUB,XMY,XMTEXT,XMDUZ
  1.  ;
  1.  S MSG(1)="Date Range for Report           "_$$FMTE^XLFDT(DGBEG,2)_" to "_$$FMTE^XLFDT(DGEND,2)
  1.  S MSG(2)=""
  1.  S MSG(3)="Report Started                  "_$$HTE^XLFDT(^TMP("DGPTFRU",$J,0,"BEGIN"),2)
  1.  S MSG(4)="Report Finished                 "_$$HTE^XLFDT(^TMP("DGPTFRU",$J,0,"END"),2)
  1.  S MSG(5)="Total Time for Report           "_$$HDIFF^XLFDT(^TMP("DGPTFRU",$J,0,"END"),^TMP("DGPTFRU",$J,0,"BEGIN"),3)
  1.  S MSG(6)=""
  1.  S MSG(7)="PTF Records Scanned   "_$J($FN(+$G(^TMP("DGPTFRU",$J,0,"CNT")),","),20)
  1.  S MSG(8)="PTF Records Reported  "_$J($FN(+$G(^TMP("DGPTFRU",$J,0,"FINAL CNT")),","),20)
  1.  S MSG(9)="Patient Count         "_$J($FN(+$G(^TMP("DGPTFRU",$J,0,"PATCNT")),","),20)
  1.  ;
  1.  S XMSUB="MEANS TEST = 'U' REPORT STATISTICS"
  1.  S XMTEXT="MSG("
  1.  S XMY(DUZ)=""
  1.  S XMDUZ="DG PTF MT=U STATS"
  1.  D ^XMD
  1.  Q
  1.  ;
  1. PRINT ; Print Report
  1.  N DGNAME,DFN,LAST4,VA,PAGE,DGPIEN,DGDOD,NEWNAME
  1.  ;
  1.  S PAGE=0
  1.  D HDR
  1.  S DGNAME=""
  1.  F  S DGNAME=$O(^TMP("DGPTFRUS",$J,DGNAME)) Q:DGNAME']""  D
  1.  . S DGPIEN=0,NEWNAME=1
  1.  . F  S DGPIEN=$O(^TMP("DGPTFRUS",$J,DGNAME,DGPIEN)) Q:'DGPIEN  D
  1.  . . S DFN=$P($G(^TMP("DGPTFRUS",$J,DGNAME,DGPIEN)),U,1)
  1.  . . S LAST4=$$LAST4(DFN)
  1.  . . S DGDOD=$$DOFD(DFN)
  1.  . . I NEWNAME D
  1.  . . . W !,$E(DGNAME,1,30),LAST4
  1.  . . E  W !
  1.  . . W ?35,DGPIEN
  1.  . . W ?48,$$GET1^DIQ(45,DGPIEN,11)
  1.  . . W ?57,$$GET1^DIQ(45,DGPIEN,6)
  1.  . . W ?80,$$GET1^DIQ(45,DGPIEN,7.4)
  1.  . . W:NEWNAME ?97,DGDOD
  1.  . . S NEWNAME=0
  1.  . . I ($Y+5)>IOSL D HDR  Q
  1.  S ^TMP("DGPTFRU",$J,0,"END")=$H
  1.  Q
  1.  ;
  1. LAST4(DFN) ; Print last four of SSN
  1.  N VA
  1.  ;
  1.  D PID^VADPT6
  1.  Q " ("_VA("BID")_")"
  1.  ;
  1. DOFD(DFN) ; Print Date of Death, if there is one
  1.  N VADM
  1.  ;
  1.  D DEM^VADPT
  1.  Q $P($G(VADM(6)),U,2)
  1.  ;
  1. HDR ; Report Header
  1.  N SPACE,LINE,TAB,PRNTLN
  1.  ;
  1.  W:PAGE>0 @IOF
  1.  S PAGE=PAGE+1
  1.  ;
  1.  S PRNTLN="PTF Records Transmitted with MT Indicator of U Report"
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !?TAB,PRNTLN
  1.  S PRNTLN="Date Range: "_$$FMTE^XLFDT(DGBEG)_" thru "_$$FMTE^XLFDT(DGEND)
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !!?TAB,PRNTLN
  1.  S PRNTLN="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !?TAB,PRNTLN
  1.  S PRNTLN="Page: "_PAGE
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !?TAB,PRNTLN
  1.  W !!?35,"Record",?80,"Transmission",?97,"Date of"
  1.  W !,"Patient Name",?35,"Number",?48,"Type",?57,"Status",?80,"Date",?97,"Death"
  1.  S $P(LINE,"=",IOM)="" W !,LINE
  1.  Q