DGHTRPT ;ALB/JRC - Home Telehealth Transmissions Report ; 1/9/06 9:22am
;;5.3;Registration;**644**;Aug 13, 1993;Build 11
;
EN ;entry point from option
;Declare variable(s) and arrays
N DGSD,DGED,I,SCANARR,MSGSTAT,FLAG
N ZTDESC,ZTIO,ZTSAVE
S FLAG=""
;Prompt for starting and ending date
D GETDATES^DGHTRPT1 Q:FLAG
;Get ACK status
D GETSTAT Q:FLAG
;Get coordinator(s)
D GETCOOR Q:FLAG
;Queue Report
S ZTIO=""
S ZTDESC="Home Telehealth Transmission Report"
F I="DGSD","DGED","SCANARR","MSGSTAT" S ZTSAVE(I)=""
D EN^XUTMDEVQ("EN1^DGHTRPT",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,STOP,CNT,LN,PAGENUM,SCRNARR
S DGED1=DGED+.9999,DGSD1=DGSD-.0001,(CNT,PAGENUM,STOP)=0
S SCRNARR="^TMP(""DGHT"",$J,""SCRNARR"")"
K @SCRNARR
M @SCRNARR@("PROVIDERS")=SCANARR
D HEADER
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
;
GETSTAT ;Prompt for message status to report
N DIR,X,Y
S DIR(0)="SC^1:ALL;2:ACCEPTED;3:REJECTED"
S DIR("A")="Select message status for report"
D ^DIR
I $D(DIRUT) S FLAG=1 Q
S MSGSTAT=Y
Q
;
GETCOOR ;Prompt for coordinator(s)
N DIC,VAUTSTR,VAUTVB,VAUTNI,Y
;Get provider selection
S DIC="^VA(200,"
S VAUTSTR="CARE COORDINATOR"
S VAUTVB="SCANARR"
S VAUTNI=2
D FIRST^VAUTOMA
I Y<0 S FLAG=1 Q
Q
;
GETDATA ;Get data
;Declare variables
N PATIENT,SSN,VENDOR,COORD,CONSULT,DATE,MSGID,ACKDATE,STATUS,REJECT
N MSGTYPE,STATUS,DGDA0,DGDA1,DG0,DG1
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 node and increment conunter
...S DG0=$G(^DGHT(391.31,DGDA0,0))
...Q:DG0=""
...S DG1=$G(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
...Q:DG1=""
...S PATIENT=$P(DG0,U,2),VENDOR=$P(DG0,U,3),CONSULT=$P(DG0,U,4)
...S COORD=$P(DG0,U,5),DATE=$P(DG1,U,1),MSGID=$P(DG1,U,2)
...S ACKDATE=$P(DG1,U,6),STATUS=$P(DG1,U,7),REJECT=$P(DG1,U,8)
...S MSGTYPE=$P(DG1,U,4)
...;Check Screens
...Q:MSGSTAT'=1&(MSGSTAT'=$S(STATUS="A":2,STATUS="R":3,1:""))
...Q:'@SCRNARR@("PROVIDERS")&'$D(@SCRNARR@("PROVIDERS",COORD))
...;Resolve external values for PATIENT
...S SSN=$E($$GET1^DIQ(2,PATIENT,.09,"I"),6,9)
...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
...S COORD=$$GET1^DIQ(200,COORD,.01,"E")
...;Increment counter and save for later
...S CNT=CNT+1
...S ^TMP("DGHT",$J,CNT)=PATIENT_U_SSN_U_VENDOR_U_COORD_U_CONSULT_U_DATE_U_MSGID_U_ACKDATE_U_STATUS_U_REJECT_U_MSGTYPE
Q
S PAGENUM=PAGENUM+1
S $P(LN,"-",80)=""
W @IOF
W !,"Home Telehealth ",$S(MSGSTAT=1:"All",MSGSTAT=2:"Accepted",MSGSTAT=3:"Rejected",1:"")_" Transmissions Report ",?65,"Page: ",PAGENUM
W !!,"Report for ",$$FMTE^XLFDT(DGSD)," thru ",$$FMTE^XLFDT(DGED)
W !!,?1,"Patient",?22,"SSN",?28,"HT Vendor",?50,"Care Coordinator",?68,"Consult #"
W !?3,"Event/Trans Date",?28,"Message ID",?50,"ACK Date/Time",?69,"Status"
W !?3,"Message Type",?28,"Reject Message",?50,"Retransmitted"
W !?1,LN
Q
;
DETAIL ;Print detailed line
;Input : ^TMP("DGHT",$J) full global reference
; PATIENT - HTH Patient
; SSN - Patient SSN's last four
; VENDOR - HTH Vendor Server
; COORD - Care Coordinator
; CONSULT - CONSULT # file 123
; DATE - Event/Transmission Date
; MSGID - Message ID
; ACK DATE - ACK Date and Time
; STATUS - Registration Status
; REJECT - Reject message
; MSGTYPE - Message Type
;Output : None
;Set acknowledgement status
N RECORD,NODE,MSGID,ACKSTAT
S (MSGID,ACKSTAT,NODE)="",RECORD=0
F S RECORD=$O(^TMP("DGHT",$J,RECORD)) Q:'RECORD D Q:STOP
.S NODE=^TMP("DGHT",$J,RECORD)
.S MSGID=$P(NODE,U,7),ACKSTAT=+$$MSGSTAT^HLUTIL(MSGID)
.W !,?1,$E($P(NODE,U,1),1,20),?22,$P(NODE,U,2),?28,$E($P(NODE,U,3),1,20),?50,$E($P(NODE,U,4),1,16),?68,$P(NODE,U,5)
.W !?3,$E($$FMTE^XLFDT($P(NODE,U,6),"1"),1,18),?28,$P(NODE,U,7),?47,$E($$FMTE^XLFDT($P(NODE,U,8),"1"),1,18),?69,$S($P(NODE,U,9)="A":"Accepted",$P(NODE,U,9)="R":"Rejected",ACKSTAT=1:"Pending TR",ACKSTAT=2:"Awaiting AA",1:"Unknown")
.W !,?3,$S($P(NODE,U,11)="A":"Activation",$P(NODE,U,11)="I":"Inactivation",1:""),?28,$P(NODE,U,10)
.;if there is data in the "HTHNOACK" node resolve number of retries
.I $O(^DGHT(391.31,"HTHNOACK",$S(MSGID'="":MSGID,1:0),0)) D
..N RECORD,TRANS,RETRANS
..S (RECORD,TRANS,RETRANS)=0
..S RECORD=$O(^DGHT(391.31,"HTHNOACK",MSGID,0)),TRANS=$O(^DGHT(391.31,"HTHNOACK",MSGID,RECORD,0)),RETRANS=$P($G(^DGHT(391.31,"HTHNOACK",MSGID,RECORD,TRANS)),U,1)
..W ?50,RETRANS
.W !
.I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
Q
;
TOTAL ;Report totals
W !!?1,"Total Number of Home Telehealth Records: ",?23,CNT
Q
;
WAIT ;End of page logic
;Input ; None
;Output ; STOP - Flag inidcating if printing should continue
; 1 = Stop 0 = Continue
;
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
;CRT - Prompt for continue
I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
.F Q:$Y>(IOSL-3) W !
.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[HDGHTRPT 6001 printed Apr 09, 2024@22:02:35 Page 2
DGHTRPT ;ALB/JRC - Home Telehealth Transmissions Report ; 1/9/06 9:22am
+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,SCANARR,MSGSTAT,FLAG
+3 NEW ZTDESC,ZTIO,ZTSAVE
+4 SET FLAG=""
+5 ;Prompt for starting and ending date
+6 DO GETDATES^DGHTRPT1
if FLAG
QUIT
+7 ;Get ACK status
+8 DO GETSTAT
if FLAG
QUIT
+9 ;Get coordinator(s)
+10 DO GETCOOR
if FLAG
QUIT
+11 ;Queue Report
+12 SET ZTIO=""
+13 SET ZTDESC="Home Telehealth Transmission Report"
+14 FOR I="DGSD","DGED","SCANARR","MSGSTAT"
SET ZTSAVE(I)=""
+15 DO EN^XUTMDEVQ("EN1^DGHTRPT",ZTDESC,.ZTSAVE)
+16 QUIT
+17 ;
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,STOP,CNT,LN,PAGENUM,SCRNARR
+8 SET DGED1=DGED+.9999
SET DGSD1=DGSD-.0001
SET (CNT,PAGENUM,STOP)=0
+9 SET SCRNARR="^TMP(""DGHT"",$J,""SCRNARR"")"
+10 KILL @SCRNARR
+11 MERGE @SCRNARR@("PROVIDERS")=SCANARR
+12 DO HEADER
+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 ;
GETSTAT ;Prompt for message status to report
+1 NEW DIR,X,Y
+2 SET DIR(0)="SC^1:ALL;2:ACCEPTED;3:REJECTED"
+3 SET DIR("A")="Select message status for report"
+4 DO ^DIR
+5 IF $DATA(DIRUT)
SET FLAG=1
QUIT
+6 SET MSGSTAT=Y
+7 QUIT
+8 ;
GETCOOR ;Prompt for coordinator(s)
+1 NEW DIC,VAUTSTR,VAUTVB,VAUTNI,Y
+2 ;Get provider selection
+3 SET DIC="^VA(200,"
+4 SET VAUTSTR="CARE COORDINATOR"
+5 SET VAUTVB="SCANARR"
+6 SET VAUTNI=2
+7 DO FIRST^VAUTOMA
+8 IF Y<0
SET FLAG=1
QUIT
+9 QUIT
+10 ;
GETDATA ;Get data
+1 ;Declare variables
+2 NEW PATIENT,SSN,VENDOR,COORD,CONSULT,DATE,MSGID,ACKDATE,STATUS,REJECT
+3 NEW MSGTYPE,STATUS,DGDA0,DGDA1,DG0,DG1
+4 FOR
SET DGSD1=$ORDER(^DGHT(391.31,"C",DGSD1))
if (DGSD1>DGED1)!('DGSD1)
QUIT
Begin DoDot:1
+5 SET DGDA0=0
+6 FOR
SET DGDA0=$ORDER(^DGHT(391.31,"C",DGSD1,DGDA0))
if 'DGDA0
QUIT
Begin DoDot:2
+7 SET DGDA1=0
+8 FOR
SET DGDA1=$ORDER(^DGHT(391.31,"C",DGSD1,DGDA0,DGDA1))
if 'DGDA1
QUIT
Begin DoDot:3
+9 ;Get data node and increment conunter
+10 SET DG0=$GET(^DGHT(391.31,DGDA0,0))
+11 if DG0=""
QUIT
+12 SET DG1=$GET(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
+13 if DG1=""
QUIT
+14 SET PATIENT=$PIECE(DG0,U,2)
SET VENDOR=$PIECE(DG0,U,3)
SET CONSULT=$PIECE(DG0,U,4)
+15 SET COORD=$PIECE(DG0,U,5)
SET DATE=$PIECE(DG1,U,1)
SET MSGID=$PIECE(DG1,U,2)
+16 SET ACKDATE=$PIECE(DG1,U,6)
SET STATUS=$PIECE(DG1,U,7)
SET REJECT=$PIECE(DG1,U,8)
+17 SET MSGTYPE=$PIECE(DG1,U,4)
+18 ;Check Screens
+19 if MSGSTAT'=1&(MSGSTAT'=$SELECT(STATUS="A"
QUIT
+20 if '@SCRNARR@("PROVIDERS")&'$DATA(@SCRNARR@("PROVIDERS",COORD))
QUIT
+21 ;Resolve external values for PATIENT
+22 SET SSN=$EXTRACT($$GET1^DIQ(2,PATIENT,.09,"I"),6,9)
+23 SET PATIENT=$$GET1^DIQ(2,PATIENT,.01,"E")
+24 ;Resolve external value for VENDOR
+25 SET VENDOR=$$GET1^DIQ(4,VENDOR,.01,"E")
+26 ;Resolve external value for COORD
+27 SET COORD=$$GET1^DIQ(200,COORD,.01,"E")
+28 ;Increment counter and save for later
+29 SET CNT=CNT+1
+30 SET ^TMP("DGHT",$JOB,CNT)=PATIENT_U_SSN_U_VENDOR_U_COORD_U_CONSULT_U_DATE_U_MSGID_U_ACKDATE_U_STATUS_U_REJECT_U_MSGTYPE
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
+1 SET PAGENUM=PAGENUM+1
+2 SET $PIECE(LN,"-",80)=""
+3 WRITE @IOF
+4 WRITE !,"Home Telehealth ",$SELECT(MSGSTAT=1:"All",MSGSTAT=2:"Accepted",MSGSTAT=3:"Rejected",1:"")_" Transmissions Report ",?65,"Page: ",PAGENUM
+5 WRITE !!,"Report for ",$$FMTE^XLFDT(DGSD)," thru ",$$FMTE^XLFDT(DGED)
+6 WRITE !!,?1,"Patient",?22,"SSN",?28,"HT Vendor",?50,"Care Coordinator",?68,"Consult #"
+7 WRITE !?3,"Event/Trans Date",?28,"Message ID",?50,"ACK Date/Time",?69,"Status"
+8 WRITE !?3,"Message Type",?28,"Reject Message",?50,"Retransmitted"
+9 WRITE !?1,LN
+10 QUIT
+11 ;
DETAIL ;Print detailed line
+1 ;Input : ^TMP("DGHT",$J) full global reference
+2 ; PATIENT - HTH Patient
+3 ; SSN - Patient SSN's last four
+4 ; VENDOR - HTH Vendor Server
+5 ; COORD - Care Coordinator
+6 ; CONSULT - CONSULT # file 123
+7 ; DATE - Event/Transmission Date
+8 ; MSGID - Message ID
+9 ; ACK DATE - ACK Date and Time
+10 ; STATUS - Registration Status
+11 ; REJECT - Reject message
+12 ; MSGTYPE - Message Type
+13 ;Output : None
+14 ;Set acknowledgement status
+15 NEW RECORD,NODE,MSGID,ACKSTAT
+16 SET (MSGID,ACKSTAT,NODE)=""
SET RECORD=0
+17 FOR
SET RECORD=$ORDER(^TMP("DGHT",$JOB,RECORD))
if 'RECORD
QUIT
Begin DoDot:1
+18 SET NODE=^TMP("DGHT",$JOB,RECORD)
+19 SET MSGID=$PIECE(NODE,U,7)
SET ACKSTAT=+$$MSGSTAT^HLUTIL(MSGID)
+20 WRITE !,?1,$EXTRACT($PIECE(NODE,U,1),1,20),?22,$PIECE(NODE,U,2),?28,$EXTRACT($PIECE(NODE,U,3),1,20),?50,$EXTRACT($PIECE(NODE,U,4),1,16),?68,$PIECE(NODE,U,5)
+21 WRITE !?3,$EXTRACT($$FMTE^XLFDT($PIECE(NODE,U,6),"1"),1,18),?28,$PIECE(NODE,U,7),?47,$EXTRACT($$FMTE^XLFDT(...
... $PIECE(NODE,U,8),"1"),1,18),?69,$SELECT($PIECE(NODE,U,9)="A":"Accepted",$PIECE(NODE,U,9)="R":"Rejected",ACKSTAT=1:"Pending TR",ACKSTAT=2:"Awaiting AA",1:"Unknown")
+22 WRITE !,?3,$SELECT($PIECE(NODE,U,11)="A":"Activation",$PIECE(NODE,U,11)="I":"Inactivation",1:""),?28,$PIECE(NODE,U,10)
+23 ;if there is data in the "HTHNOACK" node resolve number of retries
+24 IF $ORDER(^DGHT(391.31,"HTHNOACK",$SELECT(MSGID'="":MSGID,1:0),0))
Begin DoDot:2
+25 NEW RECORD,TRANS,RETRANS
+26 SET (RECORD,TRANS,RETRANS)=0
+27 SET RECORD=$ORDER(^DGHT(391.31,"HTHNOACK",MSGID,0))
SET TRANS=$ORDER(^DGHT(391.31,"HTHNOACK",MSGID,RECORD,0))
SET RETRANS=$PIECE($GET(^DGHT(391.31,"HTHNOACK",MSGID,RECORD,TRANS)),U,1)
+28 WRITE ?50,RETRANS
End DoDot:2
+29 WRITE !
+30 IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
End DoDot:1
if STOP
QUIT
+31 QUIT
+32 ;
TOTAL ;Report totals
+1 WRITE !!?1,"Total Number of Home Telehealth Records: ",?23,CNT
+2 QUIT
+3 ;
WAIT ;End of page logic
+1 ;Input ; None
+2 ;Output ; STOP - Flag inidcating if printing should continue
+3 ; 1 = Stop 0 = Continue
+4 ;
+5 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+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 SET DIR(0)="E"
+10 DO ^DIR
+11 SET STOP=$SELECT(Y'=1:1,1:0)
End DoDot:1
QUIT
+12 ;Background task - check taskman
+13 SET STOP=$$S^%ZTLOAD()
+14 IF STOP
Begin DoDot:1
+15 WRITE !,"*********************************************"
+16 WRITE !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
+17 WRITE !,"*********************************************"
End DoDot:1
+18 QUIT
EXIT ;Kill temp global
+1 KILL ^TMP("DGHT",$JOB)
+2 QUIT
