DVBA8861 ;ALB/DJS - STATUS REPORT OF 8861 REQUESTS FOR MEDICAL SERVICES, CHAPTER 31 ; 8/8/12 4:48pm
;;2.7;AMIE;**181**;Apr 10, 1995;Build 38
;
Q ;no direct entry
;
STATRPT(BDATE,EDATE,RORPT,DVBSTAT,DLMTR) ; entry point of 8861 report
;
; Input:
; BDATE - beginning date for report
; EDATE - ending date for report
; RORPT - regional office to report on or "ALL"
; DVBSTAT - requested status for report
; DLMTR - delimiter indicator (0=no;1=yes)
;
N EXBDAT ;beginning date
N EXEDAT ;end date
N EXSTAT ;request status
N DVBRS ;request status conversion results
N REQERR ;Fileman error message
N REQCNT ;number of found records
;
K ^TMP("VOCREQ",$J)
S EXBDAT=$$FMTE^XLFDT(BDATE,"5DZ")
S EXEDAT=$$FMTE^XLFDT(EDATE,"5DZ")
I DVBSTAT="A" S EXSTAT="ALL"
E D
. D CHK^DIE(396.9,13,"E",DVBSTAT,.DVBRS,"REQERR")
. S EXSTAT=$G(DVBRS(0))
S (REQCNT,TOTPEND,AVGPEND,TOTCMPL,AVGCMPL)=0
F STAT="C","N","P","X" S CNT(STAT)=0
;
; find records matching search criteria
D FINDRECS(BDATE,EDATE,RORPT,DVBSTAT,.REQCNT)
;
; output results
I 'REQCNT D
. W "NO DATA FOUND"
E D
. S RGNLOFC=$$SITE^VASITE,SITE=$P(RGNLOFC,U,2)_" ("_$P(RGNLOFC,U,3)_")" S:RORPT="ALL" ROREPRT="ALL"
. S:RORPT'="ALL" RO4RPT=$$NS^XUAF4(RORPT),ROREPRT=$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")"
. I 'DLMTR D HEADER(EXBDAT,EXEDAT,EXSTAT),PRINTND,NDTOTAL ;print non-delimited records & totals
. I DLMTR D DLMTHDR(EXBDAT,EXEDAT,EXSTAT),PRTDLMT,DLMTOTL ;print delimited records & totals
K ^TMP("VOCREQ",$J)
D KILL
Q
;
FINDRECS(BDAT,EDAT,RORPT,DVBSTAT,CNT) ; find record matches
;
; Input:
; BDAT - beginning date for report
; EDAT - ending date for report
; RORPT - regional office to report on or "ALL"
; DVBSTAT - requested status (internal format)
; CNT - record count
;
N REQIEN ; 8861 Request IEN
N FLDS ; field array in external format
;
S STAT="",(DONE,DONE2)=0
F S STAT=$O(^DVB(396.9,"ARSDT",STAT)) Q:STAT="" I (STAT=DVBSTAT)!(DVBSTAT="A") D
. S REQDT=BDATE
. F S REQDT=$O(^DVB(396.9,"ARSDT",STAT,REQDT)) S RQSTDT=$P(REQDT,".") S:REQDT="" DONE=1 Q:(DONE&(REQDT=""))!(RQSTDT>EDATE)!(REQDT<BDATE) D S DONE=0
. . S REQIEN=""
. . F S REQIEN=$O(^DVB(396.9,"ARSDT",STAT,REQDT,REQIEN)) S:REQIEN="" DONE2=1 Q:(DONE2&(REQIEN="")) D S DONE2=0
. . . K FLDS
. . . I $$SETFLDS(REQIEN,.FLDS) D
. . . . S CNT=CNT+1
. . . . S ^TMP("VOCREQ",$J,RO,RPTSTAT,NM,CNT)=FLDS("REQDT")_U_FLDS("REQSTAT")_U_FLDS("NM")_U_FLDS("SS")_U_FLDS("POCNM")_U_FLDS("POCLOC")_U_FLDS("PENDING")_U_FLDS("CANCEL")
. . . . S ^TMP("VOCREQ",$J,RO,RPTSTAT,NM,CNT)=^TMP("VOCREQ",$J,RO,RPTSTAT,NM,CNT)_U_FLDS("COMPLETE")_U_FLDS("CNSTOSVC")_U_FLDS("APPTDAYS")_U_FLDS("APPTDT")_U_FLDS("CNSLDT")
. . . Q
. . Q
. Q
Q
;
SETFLDS(REQIEN,REQFLDS) ;build field array in external format
;
; Integration Agreement Reference # 10061 - DEM^VADPT
;
; Input:
; REQIEN - 8861 Request IEN
; REQFLDS - field array passed by reference
;
; Output:
; REQFLDS("REQDT") - request date
; REQFLDS("REQSTAT") - request status
; REQFLDS("NM") - patient name
; REQFLDS("SS") - patient SSN
; REQFLDS("POCNM") - POC name
; REQFLDS("POCLOC") - POC location (RO name & station number)
; REQFLDS("APPTDT") - appointment dates
; REQFLDS("CNSLDT") - date consult is linked to 8861 request
; REQFLDS("CNSTITL") - consult To Service
; REQFLDS("PENDING") - number of days pending for pending requests
; REQFLDS("CANCEL") - number of days from receipt of 8861 to cancellation
; REQFLDS("COMPLETE") - number of days from receipt of 8861 to complete
; RO - Regional Office of requestor used to filter records by
;
N DFN ; PATIENT file IEN used in VADPT call
N DVBREQ ; 8861 Request data field array
N REQSTAT ; status of current request
N REQRSLT ; function result
N DVBCNARR ; consult return array
N CNSLTS ; consults data array
N VADM ; VADPT return array
N FLDS ; results return array
N APPTARY ; appointment retrieval array
N APPTCNT ; count of appointments
N APPTDT1 ; retrieved appointment record(s)
;
S (REQRSLT,PENDING,DAYS2CMP,CANCEL)=0
D NOW^%DTC S TODAY=X
S REQIENS=+$G(REQIEN)_","
D GETS^DIQ(396.9,REQIENS,".01;2;3;4;11;13;15","IE","DVBREQ","")
S REQFLDS("POCNM")=$G(DVBREQ(396.9,REQIENS,11,"E"))
S RO=$G(DVBREQ(396.9,REQIENS,3,"I")) I RO'=RORPT&(RORPT'="ALL") S REQRSLT=0 Q REQRSLT
I RO'="" S ROSTANM=$$NS^XUAF4(RO),REQFLDS("POCLOC")=$P(ROSTANM,U,1)_" ("_$P(ROSTANM,U,2)_")"
E I RO="" S RO=0,REQFLDS("POCLOC")="UNDEFINED"
S DFN=$G(DVBREQ(396.9,REQIENS,4,"I"))
D DEM^VADPT
I $G(VADM(1))'="" D
. S (REQFLDS("NM"),NM)=$G(VADM(1))
. S REQFLDS("SS")=+$G(VADM(2))
. S REQESTDT=$G(DVBREQ(396.9,REQIENS,.01,"I"))
. S REQFLDS("REQDT")=$$FMTE^XLFDT(REQESTDT,"2DZ")
. S REQFLDS("COMPLETE")=0
. I STAT="C" S COMPLTDT=$G(DVBREQ(396.9,REQIENS,2,"I")) I $G(COMPLTDT)'="" S DAYS2CMP=+$$FMDIFF^XLFDT(COMPLTDT,REQESTDT),TOTCMPL=TOTCMPL+DAYS2CMP,REQFLDS("COMPLETE")=DAYS2CMP
. I STAT'="X" S REQFLDS("CANCEL")=0
. E I STAT="X" S CANCLDT=$G(DVBREQ(396.9,REQIENS,15,"I")) I $G(CANCLDT)'="" S CANCEL=+$$FMDIFF^XLFDT(CANCLDT,REQESTDT),REQFLDS("CANCEL")=CANCEL
. S REQFLDS("REQSTAT")=$G(DVBREQ(396.9,REQIENS,13,"E"))
. S (REQFLDS("CNSLDT"),REQFLDS("CNSTOSVC"),REQFLDS("APPTDT"))="",REQFLDS("APPTDAYS")=0
. D GETS^DIQ(396.9,REQIENS,"14*","I","DVBCNARR","ARRAY")
. S CNSLDT=""
. I '$D(ARRAY)&($D(DVBCNARR)) D
. . S (CONIENS,CNSLIENS)=""
. . S CONIENS=$O(DVBCNARR(396.914,CONIENS)) Q:CONIENS="" D
. . . S CNSLIENS=+$G(DVBCNARR(396.914,CONIENS,.01,"I"))_","
. . . D GETS^DIQ(123,CNSLIENS,"1;3","IE","CNSLTS","CNSLERR")
. . . I '$D(CNSLERR) D
. . . . S CNSLDT=$G(CNSLTS(123,CNSLIENS,3,"I"))
. . . . S REQFLDS("CNSLDT")=$$FMTE^XLFDT($G(CNSLTS(123,CNSLIENS,3,"I")),"2DZ")
. . . . S REQFLDS("CNSTOSVC")=$G(CNSLTS(123,CNSLIENS,1,"E"))
. . . . ; get appointment data
. . . . K ^TMP($J,"SDAMA301")
. . . . S APPTARY("FLDS")="1;33",APPTARY("SORT")="P",APPTARY(4)=DFN,APPTARY(1)=CNSLDT
. . . . S APPTCNT=$$SDAPI^SDAMA301(.APPTARY) I APPTCNT<0 S APPTERR=$$ERR() Q
. . . . I APPTCNT>0 S APPTDT="" F S APPTDT=$O(^TMP($J,"SDAMA301",DFN,APPTDT)) Q:APPTDT']"" S APPTDT1=$G(^TMP($J,"SDAMA301",DFN,APPTDT,0)) Q:APPTDT1']"" D
. . . . . S CNSLT=+$G(DVBCNARR(396.914,CONIENS,.01,"I")),CNSLTLNK=$P(APPTDT1,U,6) Q:('$G(CNSLTLNK)!(CNSLT'=CNSLTLNK))
. . . . . S REQFLDS("APPTDT")=$$FMTE^XLFDT(APPTDT,"2DZ")
. . . . . S APPTDAYS=+$$FMDIFF^XLFDT(APPTDT,REQDT),REQFLDS("APPTDAYS")=APPTDAYS
. . . . . K ^TMP($J,"SDAMA301")
. . . . Q
. . . Q
. . Q
. S REQFLDS("PENDING")=0 ; do not calculate number of days pending unless status="P" (below)
. I STAT="P"&($G(CNSLDT)'="") S PENDING=+$$FMDIFF^XLFDT(TODAY,CNSLDT),REQFLDS("PENDING")=PENDING,TOTPEND=TOTPEND+PENDING
. S RPTSTAT=STAT
. S REQRSLT=1
Q REQRSLT
;
ERR() ; Process error message.
N APPTERR
S APPTERR=0
I $D(^TMP($J,"SDAMA301",101)) D
. S APPTERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***"
I $D(^TMP($J,"SDAMA301",115)) D
. S APPTERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***"
I $D(^TMP($J,"SDAMA301",116)) D
. S APPTERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***"
I $D(^TMP($J,"SDAMA301",117)) D
. S APPTERR=117_"^"_" *** RSA: Other undefined error has occurred ***"
Q APPTERR
;
DLMTHDR(EXBDAT,EXEDAT,EXSTAT) ;output delimited format header
;
; Input:
; EXBDAT - beginning date (external format)
; EXEDAT - ending date (external format)
; EXSTAT - request status (external format)
;
W "8861 Request for Medical Services, Chapter 31 Status Report"
W !,"Date Range: "_EXBDAT_" - "_EXEDAT
W !,"Regional Office: ",ROREPRT," for site: ",SITE
W !,"Request Status: ",EXSTAT
W !,"DateReceived^ReqStat^PatientName^SSN^POCName^POCLocation^PendDays^CnclDays^Consults^ApptDays^ApptDate^ConsultDate"
Q
;
PRTDLMT ; output delimited format details
;
N REGOFF ; regional office - sort criteria
N VOCG ; generic counter
;
S REGOFF=""
F S REGOFF=$O(^TMP("VOCREQ",$J,REGOFF)) Q:REGOFF="" D
. I RORPT="ALL" S RO4RPT=$$NS^XUAF4(REGOFF),REGOPRT=$S(REGOFF=0:"UNSPECIFIED",1:$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")") W !!!," Regional Office: " W REGOPRT,!?20 F I=1:1:$L(REGOPRT) W "-"
. I DVBSTAT="A" F RSTAT="N","P","X","C" D DLM
. E I DVBSTAT'="A" S RSTAT=RPTSTAT D DLM
Q
;
DLM ; write delimited detail data
;
Q:'$D(^TMP("VOCREQ",$J,REGOFF,RSTAT))
I $D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) W !
S NM=""
F S NM=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM)) Q:NM="" D
. S VOCG=""
. F S VOCG=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)) Q:VOCG="" D
. . I $P(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG),U,7)=0 S $P(^TMP("VOCREQ",$J,REGOFF,RSTAT,VOCG),U,7)="" ; don't print 0 days pending
. . W !,^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)
. . S CNT(RSTAT)=CNT(RSTAT)+1
Q
;
DLMTOTL ; print totals in delimited format
;
; Input:
; AVGPEND - average days pending
; AVGCMPL - average days to complete
;
S:TOTPEND AVGPEND=TOTPEND\CNT("P") S:TOTCMPL AVGCMPL=TOTCMPL\CNT("C")
;
W !!,"Avg Days^Avg Days^New^Pending^Cancelled^Complete",!
W "Totals for R.O.^Pending^Complete^Requests^Requests^Requests^Requests^Totals",!
W ROREPRT_"^"_AVGPEND_"^"_AVGCMPL_"^"_$G(CNT("N"))_"^"_$G(CNT("P"))_"^"_$G(CNT("X"))_"^"_$G(CNT("C"))_"^"_REQCNT
Q
;
;
; Input:
; EXBDAT - beginning date (external format)
; EXEDAT - ending date (external format)
; EXSTAT - request status (external format)
;
W "8861 Request for Medical Services, Chapter 31 Status Report"
W !,"Date Range: ",EXBDAT," - ",EXEDAT
W !,"Regional Office: ",ROREPRT," for site: ",SITE
W !,"Request Status: ",EXSTAT
W !!,"Date",?17,"Patient",?43,"POC",?59,"POC",?78,"Pend",?83,"Canc",?88,"Comp",?93,"Consult",?109,"Appt Appt",?122,"Consult"
W !,"Received",?9,"Status",?17,"Name",?38,"SSN",?43,"Name",?59,"Location"
W ?78,"Days",?83,"Days",?88,"Days",?93,"Service",?109,"Days Date",?122,"Date"
Q
;
PRINTND ; output plain format details
;
N REGOFF ; regional office - sort criteria
N VOCG ; generic counter
;
S REGOFF=""
F S REGOFF=$O(^TMP("VOCREQ",$J,REGOFF)) Q:REGOFF="" D
. I RORPT="ALL" S RO4RPT=$$NS^XUAF4(REGOFF),REGOPRT=$S(REGOFF=0:"UNSPECIFIED",1:$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")") W !!!," Regional Office: " W REGOPRT,!?20 F I=1:1:$L(REGOPRT) W "-"
. I DVBSTAT="A" F RSTAT="N","P","X","C" D ND1
. E I DVBSTAT'="A" S RSTAT=RPTSTAT D ND1
Q
;
ND1 ; write plain detail data
;
Q:'$D(^TMP("VOCREQ",$J,REGOFF,RSTAT))
I $D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) W !
S NM=""
F S NM=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM)) Q:NM="" D
. S VOCG=""
. F S VOCG=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)) Q:VOCG="" D
. . S VOCREC=^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)
. . S CNT(RSTAT)=CNT(RSTAT)+1
. . S REQDT=$P(VOCREC,U),REQSTAT=$E($P(VOCREC,U,2),1,4),PATIENT=$E($P(VOCREC,U,3),1,22),SSN=$P(VOCREC,U,4),LN=$L(SSN),SSN1=$E(SSN,LN-3,LN),POCNM=$E($P(VOCREC,U,5),1,15),POCLOC=$E($P(VOCREC,U,6),1,20)
. . S PENDING=$P(VOCREC,U,7),CANCEL=$P(VOCREC,U,8),COMPLETE=$P(VOCREC,U,9),CNSTOSVC=$E($P(VOCREC,U,10),1,15),APPTDAYS=$P(VOCREC,U,11),APPTDT=$P(VOCREC,U,12),CNSLDT=$P(VOCREC,U,13)
. . W !,REQDT,?10,REQSTAT,?15,PATIENT,?38,SSN1,?43,POCNM,?59,POCLOC
. I PENDING W ?78,$J(PENDING,3)
. I CANCEL W ?83,$J(CANCEL,3)
. I COMPLETE W ?88,$J(COMPLETE,3)
. W ?93,CNSTOSVC
. I APPTDAYS W ?109,$J(APPTDAYS,2)
. W ?113,APPTDT,?122,CNSLDT
Q
;
NDTOTAL ; print plain format totals section
;
; Input:
; AVGPEND - average days pending
; AVGCMPL - average days to complete
;
S:(TOTPEND&$G(CNT("P"))) AVGPEND=TOTPEND\CNT("P") S:(TOTCMPL&$G(CNT("C"))) AVGCMPL=TOTCMPL\CNT("C")
S REQCNT=$J(REQCNT,3)
;
W !!!?27,"Avg Days",?37,"Avg Days",?46,"New",?56,"Pending",?66,"Cancelled",?77,"Complete"
W !?3,"Totals for R.O.",?27,"Pending",?37,"Complete",?46,"Requests",?56,"Requests",?66,"Requests",?77,"Requests",?87,"Totals"
W !!?2,ROREPRT,?30,AVGPEND,?41,AVGCMPL,?49,$G(CNT("N")),?59,$G(CNT("P")),?70,$G(CNT("X")),?80,$G(CNT("C")),?88,REQCNT,!
Q
;
KILL ; kill local variables
;
K APPTARY,APPTDAYS,APPTDT,APPTDT1,APPTERR,ARRAY,AVGCMPL,AVGPEND,CANCEL,CANCLDT,CNSLDT,CNSLERR,CNSLIENS,CNSLT,CNSLTLNK,CNSLTS
K CNSTOSVC,COMPLETE,COMPLTDT,CONIENS,DAYS2CMP,DONE,DONE2,DVBCNARR,DVBREQ,DVBRS,DVBSTAT,I,LN,NM,PATIENT,PENDING,POCLOC,POCNM,REGOPRT
K REQDT,REQESTDT,REQIENS,RGNLOFC,RO,RO4RPT,ROREPRT,ROSTANM,RPTSTAT,RQSTDT,RSTAT,SITE,SSN,SSN1,STAT,TODAY,TOTCMPL,TOTPEND,VOCREC,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA8861 12778 printed Dec 13, 2024@01:40:12 Page 2
DVBA8861 ;ALB/DJS - STATUS REPORT OF 8861 REQUESTS FOR MEDICAL SERVICES, CHAPTER 31 ; 8/8/12 4:48pm
+1 ;;2.7;AMIE;**181**;Apr 10, 1995;Build 38
+2 ;
+3 ;no direct entry
QUIT
+4 ;
STATRPT(BDATE,EDATE,RORPT,DVBSTAT,DLMTR) ; entry point of 8861 report
+1 ;
+2 ; Input:
+3 ; BDATE - beginning date for report
+4 ; EDATE - ending date for report
+5 ; RORPT - regional office to report on or "ALL"
+6 ; DVBSTAT - requested status for report
+7 ; DLMTR - delimiter indicator (0=no;1=yes)
+8 ;
+9 ;beginning date
NEW EXBDAT
+10 ;end date
NEW EXEDAT
+11 ;request status
NEW EXSTAT
+12 ;request status conversion results
NEW DVBRS
+13 ;Fileman error message
NEW REQERR
+14 ;number of found records
NEW REQCNT
+15 ;
+16 KILL ^TMP("VOCREQ",$JOB)
+17 SET EXBDAT=$$FMTE^XLFDT(BDATE,"5DZ")
+18 SET EXEDAT=$$FMTE^XLFDT(EDATE,"5DZ")
+19 IF DVBSTAT="A"
SET EXSTAT="ALL"
+20 IF '$TEST
Begin DoDot:1
+21 DO CHK^DIE(396.9,13,"E",DVBSTAT,.DVBRS,"REQERR")
+22 SET EXSTAT=$GET(DVBRS(0))
End DoDot:1
+23 SET (REQCNT,TOTPEND,AVGPEND,TOTCMPL,AVGCMPL)=0
+24 FOR STAT="C","N","P","X"
SET CNT(STAT)=0
+25 ;
+26 ; find records matching search criteria
+27 DO FINDRECS(BDATE,EDATE,RORPT,DVBSTAT,.REQCNT)
+28 ;
+29 ; output results
+30 IF 'REQCNT
Begin DoDot:1
+31 WRITE "NO DATA FOUND"
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 SET RGNLOFC=$$SITE^VASITE
SET SITE=$PIECE(RGNLOFC,U,2)_" ("_$PIECE(RGNLOFC,U,3)_")"
if RORPT="ALL"
SET ROREPRT="ALL"
+34 if RORPT'="ALL"
SET RO4RPT=$$NS^XUAF4(RORPT)
SET ROREPRT=$PIECE(RO4RPT,U,1)_" ("_$PIECE(RO4RPT,U,2)_")"
+35 ;print non-delimited records & totals
IF 'DLMTR
DO HEADER(EXBDAT,EXEDAT,EXSTAT)
DO PRINTND
DO NDTOTAL
+36 ;print delimited records & totals
IF DLMTR
DO DLMTHDR(EXBDAT,EXEDAT,EXSTAT)
DO PRTDLMT
DO DLMTOTL
End DoDot:1
+37 KILL ^TMP("VOCREQ",$JOB)
+38 DO KILL
+39 QUIT
+40 ;
FINDRECS(BDAT,EDAT,RORPT,DVBSTAT,CNT) ; find record matches
+1 ;
+2 ; Input:
+3 ; BDAT - beginning date for report
+4 ; EDAT - ending date for report
+5 ; RORPT - regional office to report on or "ALL"
+6 ; DVBSTAT - requested status (internal format)
+7 ; CNT - record count
+8 ;
+9 ; 8861 Request IEN
NEW REQIEN
+10 ; field array in external format
NEW FLDS
+11 ;
+12 SET STAT=""
SET (DONE,DONE2)=0
+13 FOR
SET STAT=$ORDER(^DVB(396.9,"ARSDT",STAT))
if STAT=""
QUIT
IF (STAT=DVBSTAT)!(DVBSTAT="A")
Begin DoDot:1
+14 SET REQDT=BDATE
+15 FOR
SET REQDT=$ORDER(^DVB(396.9,"ARSDT",STAT,REQDT))
SET RQSTDT=$PIECE(REQDT,".")
if REQDT=""
SET DONE=1
if (DONE&(REQDT=""))!(RQSTDT>EDATE)!(REQDT<BDATE)
QUIT
Begin DoDot:2
+16 SET REQIEN=""
+17 FOR
SET REQIEN=$ORDER(^DVB(396.9,"ARSDT",STAT,REQDT,REQIEN))
if REQIEN=""
SET DONE2=1
if (DONE2&(REQIEN=""))
QUIT
Begin DoDot:3
+18 KILL FLDS
+19 IF $$SETFLDS(REQIEN,.FLDS)
Begin DoDot:4
+20 SET CNT=CNT+1
+21 SET ^TMP("VOCREQ",$JOB,RO,RPTSTAT,NM,CNT)=FLDS("REQDT")_U_FLDS("REQSTAT")_U_FLDS("NM")_U_FLDS("SS")_U_FLDS("POCNM")_U_FLDS("POCLOC")_U_FLDS("PENDING")_U_FLDS("CANCEL")
+22 SET ^TMP("VOCREQ",$JOB,RO,RPTSTAT,NM,CNT)=^TMP("VOCREQ",$JOB,RO,RPTSTAT,NM,CNT)_U_FLDS("COMPLETE")_U_FLDS("CNSTOSVC")_U_FLDS("APPTDAYS")_U_FLDS("APPTDT")_U_FLDS("CNSLDT")
End DoDot:4
+23 QUIT
End DoDot:3
SET DONE2=0
+24 QUIT
End DoDot:2
SET DONE=0
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
SETFLDS(REQIEN,REQFLDS) ;build field array in external format
+1 ;
+2 ; Integration Agreement Reference # 10061 - DEM^VADPT
+3 ;
+4 ; Input:
+5 ; REQIEN - 8861 Request IEN
+6 ; REQFLDS - field array passed by reference
+7 ;
+8 ; Output:
+9 ; REQFLDS("REQDT") - request date
+10 ; REQFLDS("REQSTAT") - request status
+11 ; REQFLDS("NM") - patient name
+12 ; REQFLDS("SS") - patient SSN
+13 ; REQFLDS("POCNM") - POC name
+14 ; REQFLDS("POCLOC") - POC location (RO name & station number)
+15 ; REQFLDS("APPTDT") - appointment dates
+16 ; REQFLDS("CNSLDT") - date consult is linked to 8861 request
+17 ; REQFLDS("CNSTITL") - consult To Service
+18 ; REQFLDS("PENDING") - number of days pending for pending requests
+19 ; REQFLDS("CANCEL") - number of days from receipt of 8861 to cancellation
+20 ; REQFLDS("COMPLETE") - number of days from receipt of 8861 to complete
+21 ; RO - Regional Office of requestor used to filter records by
+22 ;
+23 ; PATIENT file IEN used in VADPT call
NEW DFN
+24 ; 8861 Request data field array
NEW DVBREQ
+25 ; status of current request
NEW REQSTAT
+26 ; function result
NEW REQRSLT
+27 ; consult return array
NEW DVBCNARR
+28 ; consults data array
NEW CNSLTS
+29 ; VADPT return array
NEW VADM
+30 ; results return array
NEW FLDS
+31 ; appointment retrieval array
NEW APPTARY
+32 ; count of appointments
NEW APPTCNT
+33 ; retrieved appointment record(s)
NEW APPTDT1
+34 ;
+35 SET (REQRSLT,PENDING,DAYS2CMP,CANCEL)=0
+36 DO NOW^%DTC
SET TODAY=X
+37 SET REQIENS=+$GET(REQIEN)_","
+38 DO GETS^DIQ(396.9,REQIENS,".01;2;3;4;11;13;15","IE","DVBREQ","")
+39 SET REQFLDS("POCNM")=$GET(DVBREQ(396.9,REQIENS,11,"E"))
+40 SET RO=$GET(DVBREQ(396.9,REQIENS,3,"I"))
IF RO'=RORPT&(RORPT'="ALL")
SET REQRSLT=0
QUIT REQRSLT
+41 IF RO'=""
SET ROSTANM=$$NS^XUAF4(RO)
SET REQFLDS("POCLOC")=$PIECE(ROSTANM,U,1)_" ("_$PIECE(ROSTANM,U,2)_")"
+42 IF '$TEST
IF RO=""
SET RO=0
SET REQFLDS("POCLOC")="UNDEFINED"
+43 SET DFN=$GET(DVBREQ(396.9,REQIENS,4,"I"))
+44 DO DEM^VADPT
+45 IF $GET(VADM(1))'=""
Begin DoDot:1
+46 SET (REQFLDS("NM"),NM)=$GET(VADM(1))
+47 SET REQFLDS("SS")=+$GET(VADM(2))
+48 SET REQESTDT=$GET(DVBREQ(396.9,REQIENS,.01,"I"))
+49 SET REQFLDS("REQDT")=$$FMTE^XLFDT(REQESTDT,"2DZ")
+50 SET REQFLDS("COMPLETE")=0
+51 IF STAT="C"
SET COMPLTDT=$GET(DVBREQ(396.9,REQIENS,2,"I"))
IF $GET(COMPLTDT)'=""
SET DAYS2CMP=+$$FMDIFF^XLFDT(COMPLTDT,REQESTDT)
SET TOTCMPL=TOTCMPL+DAYS2CMP
SET REQFLDS("COMPLETE")=DAYS2CMP
+52 IF STAT'="X"
SET REQFLDS("CANCEL")=0
+53 IF '$TEST
IF STAT="X"
SET CANCLDT=$GET(DVBREQ(396.9,REQIENS,15,"I"))
IF $GET(CANCLDT)'=""
SET CANCEL=+$$FMDIFF^XLFDT(CANCLDT,REQESTDT)
SET REQFLDS("CANCEL")=CANCEL
+54 SET REQFLDS("REQSTAT")=$GET(DVBREQ(396.9,REQIENS,13,"E"))
+55 SET (REQFLDS("CNSLDT"),REQFLDS("CNSTOSVC"),REQFLDS("APPTDT"))=""
SET REQFLDS("APPTDAYS")=0
+56 DO GETS^DIQ(396.9,REQIENS,"14*","I","DVBCNARR","ARRAY")
+57 SET CNSLDT=""
+58 IF '$DATA(ARRAY)&($DATA(DVBCNARR))
Begin DoDot:2
+59 SET (CONIENS,CNSLIENS)=""
+60 SET CONIENS=$ORDER(DVBCNARR(396.914,CONIENS))
if CONIENS=""
QUIT
Begin DoDot:3
+61 SET CNSLIENS=+$GET(DVBCNARR(396.914,CONIENS,.01,"I"))_","
+62 DO GETS^DIQ(123,CNSLIENS,"1;3","IE","CNSLTS","CNSLERR")
+63 IF '$DATA(CNSLERR)
Begin DoDot:4
+64 SET CNSLDT=$GET(CNSLTS(123,CNSLIENS,3,"I"))
+65 SET REQFLDS("CNSLDT")=$$FMTE^XLFDT($GET(CNSLTS(123,CNSLIENS,3,"I")),"2DZ")
+66 SET REQFLDS("CNSTOSVC")=$GET(CNSLTS(123,CNSLIENS,1,"E"))
+67 ; get appointment data
+68 KILL ^TMP($JOB,"SDAMA301")
+69 SET APPTARY("FLDS")="1;33"
SET APPTARY("SORT")="P"
SET APPTARY(4)=DFN
SET APPTARY(1)=CNSLDT
+70 SET APPTCNT=$$SDAPI^SDAMA301(.APPTARY)
IF APPTCNT<0
SET APPTERR=$$ERR()
QUIT
+71 IF APPTCNT>0
SET APPTDT=""
FOR
SET APPTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,APPTDT))
if APPTDT']""
QUIT
SET APPTDT1=$GET(^TMP($JOB,"SDAMA301",DFN,APPTDT,0))
if APPTDT1']""
QUIT
Begin DoDot:5
+72 SET CNSLT=+$GET(DVBCNARR(396.914,CONIENS,.01,"I"))
SET CNSLTLNK=$PIECE(APPTDT1,U,6)
if ('$GET(CNSLTLNK)!(CNSLT'=CNSLTLNK))
QUIT
+73 SET REQFLDS("APPTDT")=$$FMTE^XLFDT(APPTDT,"2DZ")
+74 SET APPTDAYS=+$$FMDIFF^XLFDT(APPTDT,REQDT)
SET REQFLDS("APPTDAYS")=APPTDAYS
+75 KILL ^TMP($JOB,"SDAMA301")
End DoDot:5
+76 QUIT
End DoDot:4
+77 QUIT
End DoDot:3
+78 QUIT
End DoDot:2
+79 ; do not calculate number of days pending unless status="P" (below)
SET REQFLDS("PENDING")=0
+80 IF STAT="P"&($GET(CNSLDT)'="")
SET PENDING=+$$FMDIFF^XLFDT(TODAY,CNSLDT)
SET REQFLDS("PENDING")=PENDING
SET TOTPEND=TOTPEND+PENDING
+81 SET RPTSTAT=STAT
+82 SET REQRSLT=1
End DoDot:1
+83 QUIT REQRSLT
+84 ;
ERR() ; Process error message.
+1 NEW APPTERR
+2 SET APPTERR=0
+3 IF $DATA(^TMP($JOB,"SDAMA301",101))
Begin DoDot:1
+4 SET APPTERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***"
End DoDot:1
+5 IF $DATA(^TMP($JOB,"SDAMA301",115))
Begin DoDot:1
+6 SET APPTERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***"
End DoDot:1
+7 IF $DATA(^TMP($JOB,"SDAMA301",116))
Begin DoDot:1
+8 SET APPTERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***"
End DoDot:1
+9 IF $DATA(^TMP($JOB,"SDAMA301",117))
Begin DoDot:1
+10 SET APPTERR=117_"^"_" *** RSA: Other undefined error has occurred ***"
End DoDot:1
+11 QUIT APPTERR
+12 ;
DLMTHDR(EXBDAT,EXEDAT,EXSTAT) ;output delimited format header
+1 ;
+2 ; Input:
+3 ; EXBDAT - beginning date (external format)
+4 ; EXEDAT - ending date (external format)
+5 ; EXSTAT - request status (external format)
+6 ;
+7 WRITE "8861 Request for Medical Services, Chapter 31 Status Report"
+8 WRITE !,"Date Range: "_EXBDAT_" - "_EXEDAT
+9 WRITE !,"Regional Office: ",ROREPRT," for site: ",SITE
+10 WRITE !,"Request Status: ",EXSTAT
+11 WRITE !,"DateReceived^ReqStat^PatientName^SSN^POCName^POCLocation^PendDays^CnclDays^Consults^ApptDays^ApptDate^ConsultDate"
+12 QUIT
+13 ;
PRTDLMT ; output delimited format details
+1 ;
+2 ; regional office - sort criteria
NEW REGOFF
+3 ; generic counter
NEW VOCG
+4 ;
+5 SET REGOFF=""
+6 FOR
SET REGOFF=$ORDER(^TMP("VOCREQ",$JOB,REGOFF))
if REGOFF=""
QUIT
Begin DoDot:1
+7 IF RORPT="ALL"
SET RO4RPT=$$NS^XUAF4(REGOFF)
SET REGOPRT=$SELECT(REGOFF=0:"UNSPECIFIED",1:$PIECE(RO4RPT,U,1)_" ("_$PIECE(RO4RPT,U,2)_")")
WRITE !!!," Regional Office: "
WRITE REGOPRT,!?20
FOR I=1:1:$LENGTH(REGOPRT)
WRITE "-"
+8 IF DVBSTAT="A"
FOR RSTAT="N","P","X","C"
DO DLM
+9 IF '$TEST
IF DVBSTAT'="A"
SET RSTAT=RPTSTAT
DO DLM
End DoDot:1
+10 QUIT
+11 ;
DLM ; write delimited detail data
+1 ;
+2 if '$DATA(^TMP("VOCREQ",$JOB,REGOFF,RSTAT))
QUIT
+3 IF $DATA(^TMP("VOCREQ",$JOB,REGOFF,RSTAT))
WRITE !
+4 SET NM=""
+5 FOR
SET NM=$ORDER(^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM))
if NM=""
QUIT
Begin DoDot:1
+6 SET VOCG=""
+7 FOR
SET VOCG=$ORDER(^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM,VOCG))
if VOCG=""
QUIT
Begin DoDot:2
+8 ; don't print 0 days pending
IF $PIECE(^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM,VOCG),U,7)=0
SET $PIECE(^TMP("VOCREQ",$JOB,REGOFF,RSTAT,VOCG),U,7)=""
+9 WRITE !,^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM,VOCG)
+10 SET CNT(RSTAT)=CNT(RSTAT)+1
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
DLMTOTL ; print totals in delimited format
+1 ;
+2 ; Input:
+3 ; AVGPEND - average days pending
+4 ; AVGCMPL - average days to complete
+5 ;
+6 if TOTPEND
SET AVGPEND=TOTPEND\CNT("P")
if TOTCMPL
SET AVGCMPL=TOTCMPL\CNT("C")
+7 ;
+8 WRITE !!,"Avg Days^Avg Days^New^Pending^Cancelled^Complete",!
+9 WRITE "Totals for R.O.^Pending^Complete^Requests^Requests^Requests^Requests^Totals",!
+10 WRITE ROREPRT_"^"_AVGPEND_"^"_AVGCMPL_"^"_$GET(CNT("N"))_"^"_$GET(CNT("P"))_"^"_$GET(CNT("X"))_"^"_$GET(CNT("C"))_"^"_REQCNT
+11 QUIT
+12 ;
+1 ;
+2 ; Input:
+3 ; EXBDAT - beginning date (external format)
+4 ; EXEDAT - ending date (external format)
+5 ; EXSTAT - request status (external format)
+6 ;
+7 WRITE "8861 Request for Medical Services, Chapter 31 Status Report"
+8 WRITE !,"Date Range: ",EXBDAT," - ",EXEDAT
+9 WRITE !,"Regional Office: ",ROREPRT," for site: ",SITE
+10 WRITE !,"Request Status: ",EXSTAT
+11 WRITE !!,"Date",?17,"Patient",?43,"POC",?59,"POC",?78,"Pend",?83,"Canc",?88,"Comp",?93,"Consult",?109,"Appt Appt",?122,"Consult"
+12 WRITE !,"Received",?9,"Status",?17,"Name",?38,"SSN",?43,"Name",?59,"Location"
+13 WRITE ?78,"Days",?83,"Days",?88,"Days",?93,"Service",?109,"Days Date",?122,"Date"
+14 QUIT
+15 ;
PRINTND ; output plain format details
+1 ;
+2 ; regional office - sort criteria
NEW REGOFF
+3 ; generic counter
NEW VOCG
+4 ;
+5 SET REGOFF=""
+6 FOR
SET REGOFF=$ORDER(^TMP("VOCREQ",$JOB,REGOFF))
if REGOFF=""
QUIT
Begin DoDot:1
+7 IF RORPT="ALL"
SET RO4RPT=$$NS^XUAF4(REGOFF)
SET REGOPRT=$SELECT(REGOFF=0:"UNSPECIFIED",1:$PIECE(RO4RPT,U,1)_" ("_$PIECE(RO4RPT,U,2)_")")
WRITE !!!," Regional Office: "
WRITE REGOPRT,!?20
FOR I=1:1:$LENGTH(REGOPRT)
WRITE "-"
+8 IF DVBSTAT="A"
FOR RSTAT="N","P","X","C"
DO ND1
+9 IF '$TEST
IF DVBSTAT'="A"
SET RSTAT=RPTSTAT
DO ND1
End DoDot:1
+10 QUIT
+11 ;
ND1 ; write plain detail data
+1 ;
+2 if '$DATA(^TMP("VOCREQ",$JOB,REGOFF,RSTAT))
QUIT
+3 IF $DATA(^TMP("VOCREQ",$JOB,REGOFF,RSTAT))
WRITE !
+4 SET NM=""
+5 FOR
SET NM=$ORDER(^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM))
if NM=""
QUIT
Begin DoDot:1
+6 SET VOCG=""
+7 FOR
SET VOCG=$ORDER(^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM,VOCG))
if VOCG=""
QUIT
Begin DoDot:2
+8 SET VOCREC=^TMP("VOCREQ",$JOB,REGOFF,RSTAT,NM,VOCG)
+9 SET CNT(RSTAT)=CNT(RSTAT)+1
+10 SET REQDT=$PIECE(VOCREC,U)
SET REQSTAT=$EXTRACT($PIECE(VOCREC,U,2),1,4)
SET PATIENT=$EXTRACT($PIECE(VOCREC,U,3),1,22)
SET SSN=$PIECE(VOCREC,U,4)
SET LN=$LENGTH(SSN)
SET SSN1=$EXTRACT(SSN,LN-3,LN)
SET POCNM=$EXTRACT($PIECE(VOCREC,U,5),1,15)
SET POCLOC=$EXTRACT($PIECE(VOCREC,U,6),1,20)
+11 SET PENDING=$PIECE(VOCREC,U,7)
SET CANCEL=$PIECE(VOCREC,U,8)
SET COMPLETE=$PIECE(VOCREC,U,9)
SET CNSTOSVC=$EXTRACT($PIECE(VOCREC,U,10),1,15)
SET APPTDAYS=$PIECE(VOCREC,U,11)
SET APPTDT=$PIECE(VOCREC,U,12)
SET CNSLDT=$PIECE(VOCREC,U,13)
+12 WRITE !,REQDT,?10,REQSTAT,?15,PATIENT,?38,SSN1,?43,POCNM,?59,POCLOC
End DoDot:2
+13 IF PENDING
WRITE ?78,$JUSTIFY(PENDING,3)
+14 IF CANCEL
WRITE ?83,$JUSTIFY(CANCEL,3)
+15 IF COMPLETE
WRITE ?88,$JUSTIFY(COMPLETE,3)
+16 WRITE ?93,CNSTOSVC
+17 IF APPTDAYS
WRITE ?109,$JUSTIFY(APPTDAYS,2)
+18 WRITE ?113,APPTDT,?122,CNSLDT
End DoDot:1
+19 QUIT
+20 ;
NDTOTAL ; print plain format totals section
+1 ;
+2 ; Input:
+3 ; AVGPEND - average days pending
+4 ; AVGCMPL - average days to complete
+5 ;
+6 if (TOTPEND&$GET(CNT("P")))
SET AVGPEND=TOTPEND\CNT("P")
if (TOTCMPL&$GET(CNT("C")))
SET AVGCMPL=TOTCMPL\CNT("C")
+7 SET REQCNT=$JUSTIFY(REQCNT,3)
+8 ;
+9 WRITE !!!?27,"Avg Days",?37,"Avg Days",?46,"New",?56,"Pending",?66,"Cancelled",?77,"Complete"
+10 WRITE !?3,"Totals for R.O.",?27,"Pending",?37,"Complete",?46,"Requests",?56,"Requests",?66,"Requests",?77,"Requests",?87,"Totals"
+11 WRITE !!?2,ROREPRT,?30,AVGPEND,?41,AVGCMPL,?49,$GET(CNT("N")),?59,$GET(CNT("P")),?70,$GET(CNT("X")),?80,$GET(CNT("C")),?88,REQCNT,!
+12 QUIT
+13 ;
KILL ; kill local variables
+1 ;
+2 KILL APPTARY,APPTDAYS,APPTDT,APPTDT1,APPTERR,ARRAY,AVGCMPL,AVGPEND,CANCEL,CANCLDT,CNSLDT,CNSLERR,CNSLIENS,CNSLT,CNSLTLNK,CNSLTS
+3 KILL CNSTOSVC,COMPLETE,COMPLTDT,CONIENS,DAYS2CMP,DONE,DONE2,DVBCNARR,DVBREQ,DVBRS,DVBSTAT,I,LN,NM,PATIENT,PENDING,POCLOC,POCNM,REGOPRT
+4 KILL REQDT,REQESTDT,REQIENS,RGNLOFC,RO,RO4RPT,ROREPRT,ROSTANM,RPTSTAT,RQSTDT,RSTAT,SITE,SSN,SSN1,STAT,TODAY,TOTCMPL,TOTPEND,VOCREC,X
+5 QUIT
