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