DGHTRPT1 ;ALB/JRC - Home Telehealth Transmissions Report ; 10/14/05 12:38pm
;;5.3;Registration;**644**;Aug 13, 1993;Build 11
;
EN ;entry point from option
;Declare variable(s) and arrays
N DGSD,DGED,I,ZTDESC,ZTIO,ZTSAVE,FLAG,SORT
S FLAG=0
;Get beginning and ending dates
D GETDATES Q:FLAG
;Get sort
D GETSORT Q:FLAG
;Queue Report
S ZTIO=""
S ZTDESC="Home Telehealth Transmission Report"
F I="DGSD","DGED","SORT" D
.S ZTSAVE(I)=""
D EN^XUTMDEVQ("EN1^DGHTRPT1",ZTDESC,.ZTSAVE)
Q
;
EN1 ;Tasked entry point
;Input : DGSD - FM format report start date
; DGED - FM format report end date
;
;Output : None
;
;Declare variables
N DGSD1,DGED1,CNT,ICNT,ACNT,LN,SCRNARR
N NODE,STOP,PAGENUM,FLAG
S DGED1=DGED+.9999,DGSD1=DGSD-.0001,(CNT,ACNT,ICNT,PAGENUM,STOP)=0
S SCRNARR="^TMP(""DGHT"",$J,""SCRNARR"")",FLAG=0
K @SCRNARR
D HEADER I STOP D EXIT Q
D GETDATA
I 'CNT D Q
.W !
.W !,"***********************************************"
.W !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
.W !,"***********************************************"
.D WAIT
D DETAIL I STOP D EXIT Q
D TOTAL
D EXIT
Q
;
GETDATES ;Prompt for start date
N DIR,DIRUT,X,Y
S DIR(0)="D^:NOW:EX"
S DIR("A")="Enter Report Start Date"
S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
D ^DIR
I $D(DIRUT) S FLAG=1 Q
S DGSD=Y
;Prompt for end date
K DIR,DIRUT,X,Y
S DIR(0)="D^:NOW:EX"
S DIR("A")="Enter Report Ending Date"
S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
D ^DIR
I $D(DIRUT) S FLAG=1 Q
S DGED=Y
Q
;
GETSORT ;Select sort, 1 for patient or 2 for trans date
;Declare variables
N DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
;Get sort
S DIR(0)="SC^1:Patient;2:Transmission Date;"
S DIR("A")="Select sorting criteria"
D ^DIR
I $D(DIRUT) S FLAG=1 Q
S SORT=Y
Q
;
GETDATA ;Get data
;Declare variables
N DG0,DG1,DGDA0,DGDA1,PATIENT,VENDOR,INACTDT,DATE,MSGTYPE,STATUS
F S DGSD1=$O(^DGHT(391.31,"C",DGSD1)) Q:(DGSD1>DGED1)!('DGSD1) D
.S DGDA0=0
.F S DGDA0=$O(^DGHT(391.31,"C",DGSD1,DGDA0)) Q:'DGDA0 D
..S DGDA1=0
..F S DGDA1=$O(^DGHT(391.31,"C",DGSD1,DGDA0,DGDA1)) Q:'DGDA1 D
...;Get data nodes and icrement conunter
...S DG0=$G(^DGHT(391.31,DGDA0,0))
...Q:DG0=""
...S DG1=$G(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
...;Quit if there is no transaction data or type = inactivation
...Q:DG1=""
...Q:$P(DG1,U,4)="I"
...S PATIENT=$P(DG0,U,2),VENDOR=$P(DG0,U,3),INACTDT=$P(DG0,U,7)
...S DATE=$P(DG1,U,1),MSGTYPE=$P(DG1,U,4)
...I 'INACTDT S STATUS="Active"
...;If there is an Inactivation date validate trans status
...I INACTDT D
....S DGDA1=$O(^DGHT(391.31,DGDA0,"TRAN",DGDA1))
....S DG1=$G(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
....S STATUS=$S($P(DG1,U,7)="A":"Inactive",$P(DG1,U,7)="R":"Active",1:"Active")
...;Resolve external values for PATIENT
...S PATIENT=$$GET1^DIQ(2,PATIENT,.01,"E")
...;Resolve external value for VENDOR
...S VENDOR=$$GET1^DIQ(4,VENDOR,.01,"E")
...;Resolve external value for COORD
...;Increment counters and save for later
...S CNT=CNT+1
...I STATUS="Active" S ACNT=ACNT+1
...I STATUS="Inactive" S ICNT=ICNT+1
...S ^TMP("DGHT",$J,$S(SORT=1:PATIENT,1:DATE),CNT)=PATIENT_U_STATUS_U_DATE_U_VENDOR
Q
S PAGENUM=PAGENUM+1
S $P(LN,"-",80)=""
W @IOF
W !,"Home Telehealth Patient Summary Report ",?65,"Page: ",PAGENUM
W !!,"Report for ",$$FMTE^XLFDT(DGSD)," thru ",$$FMTE^XLFDT(DGED)
W !!,?1,"Patient",?25,"Status",?34,"Date of Last Change",?56,"HT Vendor"
W !?1,LN
Q
;
DETAIL ;Print detailed line
;Input : ^TMP("DGHT",$J) full global reference
; PATIENT - HTH Patient
; STATUS - Registration Status
; DATE - Event/Transmission Date
; VENDOR - HTH Vendor Server
;Output : None
;Declare variables
N SORT,RECORD
S SORT=""
F S SORT=$O(^TMP("DGHT",$J,SORT)) Q:SORT="" D Q:STOP
.S RECORD=0 F S RECORD=$O(^TMP("DGHT",$J,SORT,RECORD)) Q:'RECORD!(STOP) D Q:STOP
..S NODE=^TMP("DGHT",$J,SORT,RECORD)
..W !,?1,$E($P(NODE,U,1),1,22),?25,$P(NODE,U,2),?34,$$FMTE^XLFDT($P(NODE,U,3),"2Z"),?56,$E($P(NODE,U,4),1,23)
..I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
Q
;
TOTAL ;Report totals
W !!?1,"Total Number of Active Patient Record(s): ",?45,$J($FNUMBER(ACNT,",",0),8)
W !?1,"Total Number of Inactive Patient Record(s): ",?45,$J($FNUMBER(ICNT,",",0),8)
W !?1,"Total Number of Patient Record(s): ",?45,$J($FNUMBER(CNT,",",0),8)
Q
;
WAIT ;End of page logic
;Input ; None
;Output ; STOP - Flag inidcating if printing should continue
; 1 = Stop 0 = Continue
;
S STOP=0
;CRT - Prompt for continue
I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
.F Q:$Y>(IOSL-3) W !
.N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
.S DIR(0)="E"
.D ^DIR
.S STOP=$S(Y'=1:1,1:0)
;Background task - check taskman
S STOP=$$S^%ZTLOAD()
I STOP D
.W !,"*********************************************"
.W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
.W !,"*********************************************"
Q
EXIT ;Kill temp global
K ^TMP("DGHT",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGHTRPT1 5156 printed Sep 23, 2025@20:19:40 Page 2
DGHTRPT1 ;ALB/JRC - Home Telehealth Transmissions Report ; 10/14/05 12:38pm
+1 ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
+2 ;
EN ;entry point from option
+1 ;Declare variable(s) and arrays
+2 NEW DGSD,DGED,I,ZTDESC,ZTIO,ZTSAVE,FLAG,SORT
+3 SET FLAG=0
+4 ;Get beginning and ending dates
+5 DO GETDATES
if FLAG
QUIT
+6 ;Get sort
+7 DO GETSORT
if FLAG
QUIT
+8 ;Queue Report
+9 SET ZTIO=""
+10 SET ZTDESC="Home Telehealth Transmission Report"
+11 FOR I="DGSD","DGED","SORT"
Begin DoDot:1
+12 SET ZTSAVE(I)=""
End DoDot:1
+13 DO EN^XUTMDEVQ("EN1^DGHTRPT1",ZTDESC,.ZTSAVE)
+14 QUIT
+15 ;
EN1 ;Tasked entry point
+1 ;Input : DGSD - FM format report start date
+2 ; DGED - FM format report end date
+3 ;
+4 ;Output : None
+5 ;
+6 ;Declare variables
+7 NEW DGSD1,DGED1,CNT,ICNT,ACNT,LN,SCRNARR
+8 NEW NODE,STOP,PAGENUM,FLAG
+9 SET DGED1=DGED+.9999
SET DGSD1=DGSD-.0001
SET (CNT,ACNT,ICNT,PAGENUM,STOP)=0
+10 SET SCRNARR="^TMP(""DGHT"",$J,""SCRNARR"")"
SET FLAG=0
+11 KILL @SCRNARR
+12 DO HEADER
IF STOP
DO EXIT
QUIT
+13 DO GETDATA
+14 IF 'CNT
Begin DoDot:1
+15 WRITE !
+16 WRITE !,"***********************************************"
+17 WRITE !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
+18 WRITE !,"***********************************************"
+19 DO WAIT
End DoDot:1
QUIT
+20 DO DETAIL
IF STOP
DO EXIT
QUIT
+21 DO TOTAL
+22 DO EXIT
+23 QUIT
+24 ;
GETDATES ;Prompt for start date
+1 NEW DIR,DIRUT,X,Y
+2 SET DIR(0)="D^:NOW:EX"
+3 SET DIR("A")="Enter Report Start Date"
+4 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+5 DO ^DIR
+6 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+7 SET DGSD=Y
+8 ;Prompt for end date
+9 KILL DIR,DIRUT,X,Y
+10 SET DIR(0)="D^:NOW:EX"
+11 SET DIR("A")="Enter Report Ending Date"
+12 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+13 DO ^DIR
+14 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+15 SET DGED=Y
+16 QUIT
+17 ;
GETSORT ;Select sort, 1 for patient or 2 for trans date
+1 ;Declare variables
+2 NEW DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
+3 ;Get sort
+4 SET DIR(0)="SC^1:Patient;2:Transmission Date;"
+5 SET DIR("A")="Select sorting criteria"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+8 SET SORT=Y
+9 QUIT
+10 ;
GETDATA ;Get data
+1 ;Declare variables
+2 NEW DG0,DG1,DGDA0,DGDA1,PATIENT,VENDOR,INACTDT,DATE,MSGTYPE,STATUS
+3 FOR
SET DGSD1=$ORDER(^DGHT(391.31,"C",DGSD1))
if (DGSD1>DGED1)!('DGSD1)
QUIT
Begin DoDot:1
+4 SET DGDA0=0
+5 FOR
SET DGDA0=$ORDER(^DGHT(391.31,"C",DGSD1,DGDA0))
if 'DGDA0
QUIT
Begin DoDot:2
+6 SET DGDA1=0
+7 FOR
SET DGDA1=$ORDER(^DGHT(391.31,"C",DGSD1,DGDA0,DGDA1))
if 'DGDA1
QUIT
Begin DoDot:3
+8 ;Get data nodes and icrement conunter
+9 SET DG0=$GET(^DGHT(391.31,DGDA0,0))
+10 if DG0=""
QUIT
+11 SET DG1=$GET(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
+12 ;Quit if there is no transaction data or type = inactivation
+13 if DG1=""
QUIT
+14 if $PIECE(DG1,U,4)="I"
QUIT
+15 SET PATIENT=$PIECE(DG0,U,2)
SET VENDOR=$PIECE(DG0,U,3)
SET INACTDT=$PIECE(DG0,U,7)
+16 SET DATE=$PIECE(DG1,U,1)
SET MSGTYPE=$PIECE(DG1,U,4)
+17 IF 'INACTDT
SET STATUS="Active"
+18 ;If there is an Inactivation date validate trans status
+19 IF INACTDT
Begin DoDot:4
+20 SET DGDA1=$ORDER(^DGHT(391.31,DGDA0,"TRAN",DGDA1))
+21 SET DG1=$GET(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
+22 SET STATUS=$SELECT($PIECE(DG1,U,7)="A":"Inactive",$PIECE(DG1,U,7)="R":"Active",1:"Active")
End DoDot:4
+23 ;Resolve external values for PATIENT
+24 SET PATIENT=$$GET1^DIQ(2,PATIENT,.01,"E")
+25 ;Resolve external value for VENDOR
+26 SET VENDOR=$$GET1^DIQ(4,VENDOR,.01,"E")
+27 ;Resolve external value for COORD
+28 ;Increment counters and save for later
+29 SET CNT=CNT+1
+30 IF STATUS="Active"
SET ACNT=ACNT+1
+31 IF STATUS="Inactive"
SET ICNT=ICNT+1
+32 SET ^TMP("DGHT",$JOB,$SELECT(SORT=1:PATIENT,1:DATE),CNT)=PATIENT_U_STATUS_U_DATE_U_VENDOR
End DoDot:3
End DoDot:2
End DoDot:1
+33 QUIT
+1 SET PAGENUM=PAGENUM+1
+2 SET $PIECE(LN,"-",80)=""
+3 WRITE @IOF
+4 WRITE !,"Home Telehealth Patient Summary Report ",?65,"Page: ",PAGENUM
+5 WRITE !!,"Report for ",$$FMTE^XLFDT(DGSD)," thru ",$$FMTE^XLFDT(DGED)
+6 WRITE !!,?1,"Patient",?25,"Status",?34,"Date of Last Change",?56,"HT Vendor"
+7 WRITE !?1,LN
+8 QUIT
+9 ;
DETAIL ;Print detailed line
+1 ;Input : ^TMP("DGHT",$J) full global reference
+2 ; PATIENT - HTH Patient
+3 ; STATUS - Registration Status
+4 ; DATE - Event/Transmission Date
+5 ; VENDOR - HTH Vendor Server
+6 ;Output : None
+7 ;Declare variables
+8 NEW SORT,RECORD
+9 SET SORT=""
+10 FOR
SET SORT=$ORDER(^TMP("DGHT",$JOB,SORT))
if SORT=""
QUIT
Begin DoDot:1
+11 SET RECORD=0
FOR
SET RECORD=$ORDER(^TMP("DGHT",$JOB,SORT,RECORD))
if 'RECORD!(STOP)
QUIT
Begin DoDot:2
+12 SET NODE=^TMP("DGHT",$JOB,SORT,RECORD)
+13 WRITE !,?1,$EXTRACT($PIECE(NODE,U,1),1,22),?25,$PIECE(NODE,U,2),?34,$$FMTE^XLFDT($PIECE(NODE,U,3),"2Z"),?56,$EXTRACT($PIECE(NODE,U,4),1,23)
+14 IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
End DoDot:2
if STOP
QUIT
End DoDot:1
if STOP
QUIT
+15 QUIT
+16 ;
TOTAL ;Report totals
+1 WRITE !!?1,"Total Number of Active Patient Record(s): ",?45,$JUSTIFY($FNUMBER(ACNT,",",0),8)
+2 WRITE !?1,"Total Number of Inactive Patient Record(s): ",?45,$JUSTIFY($FNUMBER(ICNT,",",0),8)
+3 WRITE !?1,"Total Number of Patient Record(s): ",?45,$JUSTIFY($FNUMBER(CNT,",",0),8)
+4 QUIT
+5 ;
WAIT ;End of page logic
+1 ;Input ; None
+2 ;Output ; STOP - Flag inidcating if printing should continue
+3 ; 1 = Stop 0 = Continue
+4 ;
+5 SET STOP=0
+6 ;CRT - Prompt for continue
+7 IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)
Begin DoDot:1
+8 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+9 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+10 SET DIR(0)="E"
+11 DO ^DIR
+12 SET STOP=$SELECT(Y'=1:1,1:0)
End DoDot:1
QUIT
+13 ;Background task - check taskman
+14 SET STOP=$$S^%ZTLOAD()
+15 IF STOP
Begin DoDot:1
+16 WRITE !,"*********************************************"
+17 WRITE !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
+18 WRITE !,"*********************************************"
End DoDot:1
+19 QUIT
EXIT ;Kill temp global
+1 KILL ^TMP("DGHT",$JOB)
+2 QUIT
