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

DVBA8861.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q ;no direct entry
  1. ;
  1. STATRPT(BDATE,EDATE,RORPT,DVBSTAT,DLMTR) ; entry point of 8861 report
  1. ;
  1. ; Input:
  1. ; BDATE - beginning date for report
  1. ; EDATE - ending date for report
  1. ; RORPT - regional office to report on or "ALL"
  1. ; DVBSTAT - requested status for report
  1. ; DLMTR - delimiter indicator (0=no;1=yes)
  1. ;
  1. N EXBDAT ;beginning date
  1. N EXEDAT ;end date
  1. N EXSTAT ;request status
  1. N DVBRS ;request status conversion results
  1. N REQERR ;Fileman error message
  1. N REQCNT ;number of found records
  1. ;
  1. K ^TMP("VOCREQ",$J)
  1. S EXBDAT=$$FMTE^XLFDT(BDATE,"5DZ")
  1. S EXEDAT=$$FMTE^XLFDT(EDATE,"5DZ")
  1. I DVBSTAT="A" S EXSTAT="ALL"
  1. E D
  1. . D CHK^DIE(396.9,13,"E",DVBSTAT,.DVBRS,"REQERR")
  1. . S EXSTAT=$G(DVBRS(0))
  1. S (REQCNT,TOTPEND,AVGPEND,TOTCMPL,AVGCMPL)=0
  1. F STAT="C","N","P","X" S CNT(STAT)=0
  1. ;
  1. ; find records matching search criteria
  1. D FINDRECS(BDATE,EDATE,RORPT,DVBSTAT,.REQCNT)
  1. ;
  1. ; output results
  1. I 'REQCNT D
  1. . W "NO DATA FOUND"
  1. E D
  1. . S RGNLOFC=$$SITE^VASITE,SITE=$P(RGNLOFC,U,2)_" ("_$P(RGNLOFC,U,3)_")" S:RORPT="ALL" ROREPRT="ALL"
  1. . S:RORPT'="ALL" RO4RPT=$$NS^XUAF4(RORPT),ROREPRT=$P(RO4RPT,U,1)_" ("_$P(RO4RPT,U,2)_")"
  1. . I 'DLMTR D HEADER(EXBDAT,EXEDAT,EXSTAT),PRINTND,NDTOTAL ;print non-delimited records & totals
  1. . I DLMTR D DLMTHDR(EXBDAT,EXEDAT,EXSTAT),PRTDLMT,DLMTOTL ;print delimited records & totals
  1. K ^TMP("VOCREQ",$J)
  1. D KILL
  1. Q
  1. ;
  1. FINDRECS(BDAT,EDAT,RORPT,DVBSTAT,CNT) ; find record matches
  1. ;
  1. ; Input:
  1. ; BDAT - beginning date for report
  1. ; EDAT - ending date for report
  1. ; RORPT - regional office to report on or "ALL"
  1. ; DVBSTAT - requested status (internal format)
  1. ; CNT - record count
  1. ;
  1. N REQIEN ; 8861 Request IEN
  1. N FLDS ; field array in external format
  1. ;
  1. S STAT="",(DONE,DONE2)=0
  1. F S STAT=$O(^DVB(396.9,"ARSDT",STAT)) Q:STAT="" I (STAT=DVBSTAT)!(DVBSTAT="A") D
  1. . S REQDT=BDATE
  1. . 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
  1. . . S REQIEN=""
  1. . . F S REQIEN=$O(^DVB(396.9,"ARSDT",STAT,REQDT,REQIEN)) S:REQIEN="" DONE2=1 Q:(DONE2&(REQIEN="")) D S DONE2=0
  1. . . . K FLDS
  1. . . . I $$SETFLDS(REQIEN,.FLDS) D
  1. . . . . S CNT=CNT+1
  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")
  1. . . . . 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")
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. SETFLDS(REQIEN,REQFLDS) ;build field array in external format
  1. ;
  1. ; Integration Agreement Reference # 10061 - DEM^VADPT
  1. ;
  1. ; Input:
  1. ; REQIEN - 8861 Request IEN
  1. ; REQFLDS - field array passed by reference
  1. ;
  1. ; Output:
  1. ; REQFLDS("REQDT") - request date
  1. ; REQFLDS("REQSTAT") - request status
  1. ; REQFLDS("NM") - patient name
  1. ; REQFLDS("SS") - patient SSN
  1. ; REQFLDS("POCNM") - POC name
  1. ; REQFLDS("POCLOC") - POC location (RO name & station number)
  1. ; REQFLDS("APPTDT") - appointment dates
  1. ; REQFLDS("CNSLDT") - date consult is linked to 8861 request
  1. ; REQFLDS("CNSTITL") - consult To Service
  1. ; REQFLDS("PENDING") - number of days pending for pending requests
  1. ; REQFLDS("CANCEL") - number of days from receipt of 8861 to cancellation
  1. ; REQFLDS("COMPLETE") - number of days from receipt of 8861 to complete
  1. ; RO - Regional Office of requestor used to filter records by
  1. ;
  1. N DFN ; PATIENT file IEN used in VADPT call
  1. N DVBREQ ; 8861 Request data field array
  1. N REQSTAT ; status of current request
  1. N REQRSLT ; function result
  1. N DVBCNARR ; consult return array
  1. N CNSLTS ; consults data array
  1. N VADM ; VADPT return array
  1. N FLDS ; results return array
  1. N APPTARY ; appointment retrieval array
  1. N APPTCNT ; count of appointments
  1. N APPTDT1 ; retrieved appointment record(s)
  1. ;
  1. S (REQRSLT,PENDING,DAYS2CMP,CANCEL)=0
  1. D NOW^%DTC S TODAY=X
  1. S REQIENS=+$G(REQIEN)_","
  1. D GETS^DIQ(396.9,REQIENS,".01;2;3;4;11;13;15","IE","DVBREQ","")
  1. S REQFLDS("POCNM")=$G(DVBREQ(396.9,REQIENS,11,"E"))
  1. S RO=$G(DVBREQ(396.9,REQIENS,3,"I")) I RO'=RORPT&(RORPT'="ALL") S REQRSLT=0 Q REQRSLT
  1. I RO'="" S ROSTANM=$$NS^XUAF4(RO),REQFLDS("POCLOC")=$P(ROSTANM,U,1)_" ("_$P(ROSTANM,U,2)_")"
  1. E I RO="" S RO=0,REQFLDS("POCLOC")="UNDEFINED"
  1. S DFN=$G(DVBREQ(396.9,REQIENS,4,"I"))
  1. D DEM^VADPT
  1. I $G(VADM(1))'="" D
  1. . S (REQFLDS("NM"),NM)=$G(VADM(1))
  1. . S REQFLDS("SS")=+$G(VADM(2))
  1. . S REQESTDT=$G(DVBREQ(396.9,REQIENS,.01,"I"))
  1. . S REQFLDS("REQDT")=$$FMTE^XLFDT(REQESTDT,"2DZ")
  1. . S REQFLDS("COMPLETE")=0
  1. . 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
  1. . I STAT'="X" S REQFLDS("CANCEL")=0
  1. . 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
  1. . S REQFLDS("REQSTAT")=$G(DVBREQ(396.9,REQIENS,13,"E"))
  1. . S (REQFLDS("CNSLDT"),REQFLDS("CNSTOSVC"),REQFLDS("APPTDT"))="",REQFLDS("APPTDAYS")=0
  1. . D GETS^DIQ(396.9,REQIENS,"14*","I","DVBCNARR","ARRAY")
  1. . S CNSLDT=""
  1. . I '$D(ARRAY)&($D(DVBCNARR)) D
  1. . . S (CONIENS,CNSLIENS)=""
  1. . . S CONIENS=$O(DVBCNARR(396.914,CONIENS)) Q:CONIENS="" D
  1. . . . S CNSLIENS=+$G(DVBCNARR(396.914,CONIENS,.01,"I"))_","
  1. . . . D GETS^DIQ(123,CNSLIENS,"1;3","IE","CNSLTS","CNSLERR")
  1. . . . I '$D(CNSLERR) D
  1. . . . . S CNSLDT=$G(CNSLTS(123,CNSLIENS,3,"I"))
  1. . . . . S REQFLDS("CNSLDT")=$$FMTE^XLFDT($G(CNSLTS(123,CNSLIENS,3,"I")),"2DZ")
  1. . . . . S REQFLDS("CNSTOSVC")=$G(CNSLTS(123,CNSLIENS,1,"E"))
  1. . . . . ; get appointment data
  1. . . . . K ^TMP($J,"SDAMA301")
  1. . . . . S APPTARY("FLDS")="1;33",APPTARY("SORT")="P",APPTARY(4)=DFN,APPTARY(1)=CNSLDT
  1. . . . . S APPTCNT=$$SDAPI^SDAMA301(.APPTARY) I APPTCNT<0 S APPTERR=$$ERR() Q
  1. . . . . 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
  1. . . . . . S CNSLT=+$G(DVBCNARR(396.914,CONIENS,.01,"I")),CNSLTLNK=$P(APPTDT1,U,6) Q:('$G(CNSLTLNK)!(CNSLT'=CNSLTLNK))
  1. . . . . . S REQFLDS("APPTDT")=$$FMTE^XLFDT(APPTDT,"2DZ")
  1. . . . . . S APPTDAYS=+$$FMDIFF^XLFDT(APPTDT,REQDT),REQFLDS("APPTDAYS")=APPTDAYS
  1. . . . . . K ^TMP($J,"SDAMA301")
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . S REQFLDS("PENDING")=0 ; do not calculate number of days pending unless status="P" (below)
  1. . I STAT="P"&($G(CNSLDT)'="") S PENDING=+$$FMDIFF^XLFDT(TODAY,CNSLDT),REQFLDS("PENDING")=PENDING,TOTPEND=TOTPEND+PENDING
  1. . S RPTSTAT=STAT
  1. . S REQRSLT=1
  1. Q REQRSLT
  1. ;
  1. ERR() ; Process error message.
  1. N APPTERR
  1. S APPTERR=0
  1. I $D(^TMP($J,"SDAMA301",101)) D
  1. . S APPTERR=101_"^"_" *** RSA: Process DATABASE IS UNAVAILABLE ***"
  1. I $D(^TMP($J,"SDAMA301",115)) D
  1. . S APPTERR=115_"^"_" *** RSA: Appointment request filter contains invalid values ***"
  1. I $D(^TMP($J,"SDAMA301",116)) D
  1. . S APPTERR=116_"^"_" *** RSA: Data doesn't exist error has occurred ***"
  1. I $D(^TMP($J,"SDAMA301",117)) D
  1. . S APPTERR=117_"^"_" *** RSA: Other undefined error has occurred ***"
  1. Q APPTERR
  1. ;
  1. DLMTHDR(EXBDAT,EXEDAT,EXSTAT) ;output delimited format header
  1. ;
  1. ; Input:
  1. ; EXBDAT - beginning date (external format)
  1. ; EXEDAT - ending date (external format)
  1. ; EXSTAT - request status (external format)
  1. ;
  1. W "8861 Request for Medical Services, Chapter 31 Status Report"
  1. W !,"Date Range: "_EXBDAT_" - "_EXEDAT
  1. W !,"Regional Office: ",ROREPRT," for site: ",SITE
  1. W !,"Request Status: ",EXSTAT
  1. W !,"DateReceived^ReqStat^PatientName^SSN^POCName^POCLocation^PendDays^CnclDays^Consults^ApptDays^ApptDate^ConsultDate"
  1. Q
  1. ;
  1. PRTDLMT ; output delimited format details
  1. ;
  1. N REGOFF ; regional office - sort criteria
  1. N VOCG ; generic counter
  1. ;
  1. S REGOFF=""
  1. F S REGOFF=$O(^TMP("VOCREQ",$J,REGOFF)) Q:REGOFF="" D
  1. . 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 "-"
  1. . I DVBSTAT="A" F RSTAT="N","P","X","C" D DLM
  1. . E I DVBSTAT'="A" S RSTAT=RPTSTAT D DLM
  1. Q
  1. ;
  1. DLM ; write delimited detail data
  1. ;
  1. Q:'$D(^TMP("VOCREQ",$J,REGOFF,RSTAT))
  1. I $D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) W !
  1. S NM=""
  1. F S NM=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM)) Q:NM="" D
  1. . S VOCG=""
  1. . F S VOCG=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)) Q:VOCG="" D
  1. . . 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
  1. . . W !,^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)
  1. . . S CNT(RSTAT)=CNT(RSTAT)+1
  1. Q
  1. ;
  1. DLMTOTL ; print totals in delimited format
  1. ;
  1. ; Input:
  1. ; AVGPEND - average days pending
  1. ; AVGCMPL - average days to complete
  1. ;
  1. S:TOTPEND AVGPEND=TOTPEND\CNT("P") S:TOTCMPL AVGCMPL=TOTCMPL\CNT("C")
  1. ;
  1. W !!,"Avg Days^Avg Days^New^Pending^Cancelled^Complete",!
  1. W "Totals for R.O.^Pending^Complete^Requests^Requests^Requests^Requests^Totals",!
  1. W ROREPRT_"^"_AVGPEND_"^"_AVGCMPL_"^"_$G(CNT("N"))_"^"_$G(CNT("P"))_"^"_$G(CNT("X"))_"^"_$G(CNT("C"))_"^"_REQCNT
  1. Q
  1. ;
  1. ;
  1. ; Input:
  1. ; EXBDAT - beginning date (external format)
  1. ; EXEDAT - ending date (external format)
  1. ; EXSTAT - request status (external format)
  1. ;
  1. W "8861 Request for Medical Services, Chapter 31 Status Report"
  1. W !,"Date Range: ",EXBDAT," - ",EXEDAT
  1. W !,"Regional Office: ",ROREPRT," for site: ",SITE
  1. W !,"Request Status: ",EXSTAT
  1. W !!,"Date",?17,"Patient",?43,"POC",?59,"POC",?78,"Pend",?83,"Canc",?88,"Comp",?93,"Consult",?109,"Appt Appt",?122,"Consult"
  1. W !,"Received",?9,"Status",?17,"Name",?38,"SSN",?43,"Name",?59,"Location"
  1. W ?78,"Days",?83,"Days",?88,"Days",?93,"Service",?109,"Days Date",?122,"Date"
  1. Q
  1. ;
  1. PRINTND ; output plain format details
  1. ;
  1. N REGOFF ; regional office - sort criteria
  1. N VOCG ; generic counter
  1. ;
  1. S REGOFF=""
  1. F S REGOFF=$O(^TMP("VOCREQ",$J,REGOFF)) Q:REGOFF="" D
  1. . 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 "-"
  1. . I DVBSTAT="A" F RSTAT="N","P","X","C" D ND1
  1. . E I DVBSTAT'="A" S RSTAT=RPTSTAT D ND1
  1. Q
  1. ;
  1. ND1 ; write plain detail data
  1. ;
  1. Q:'$D(^TMP("VOCREQ",$J,REGOFF,RSTAT))
  1. I $D(^TMP("VOCREQ",$J,REGOFF,RSTAT)) W !
  1. S NM=""
  1. F S NM=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM)) Q:NM="" D
  1. . S VOCG=""
  1. . F S VOCG=$O(^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)) Q:VOCG="" D
  1. . . S VOCREC=^TMP("VOCREQ",$J,REGOFF,RSTAT,NM,VOCG)
  1. . . S CNT(RSTAT)=CNT(RSTAT)+1
  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)
  1. . . 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)
  1. . . W !,REQDT,?10,REQSTAT,?15,PATIENT,?38,SSN1,?43,POCNM,?59,POCLOC
  1. . I PENDING W ?78,$J(PENDING,3)
  1. . I CANCEL W ?83,$J(CANCEL,3)
  1. . I COMPLETE W ?88,$J(COMPLETE,3)
  1. . W ?93,CNSTOSVC
  1. . I APPTDAYS W ?109,$J(APPTDAYS,2)
  1. . W ?113,APPTDT,?122,CNSLDT
  1. Q
  1. ;
  1. NDTOTAL ; print plain format totals section
  1. ;
  1. ; Input:
  1. ; AVGPEND - average days pending
  1. ; AVGCMPL - average days to complete
  1. ;
  1. S:(TOTPEND&$G(CNT("P"))) AVGPEND=TOTPEND\CNT("P") S:(TOTCMPL&$G(CNT("C"))) AVGCMPL=TOTCMPL\CNT("C")
  1. S REQCNT=$J(REQCNT,3)
  1. ;
  1. W !!!?27,"Avg Days",?37,"Avg Days",?46,"New",?56,"Pending",?66,"Cancelled",?77,"Complete"
  1. W !?3,"Totals for R.O.",?27,"Pending",?37,"Complete",?46,"Requests",?56,"Requests",?66,"Requests",?77,"Requests",?87,"Totals"
  1. 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,!
  1. Q
  1. ;
  1. KILL ; kill local variables
  1. ;
  1. K APPTARY,APPTDAYS,APPTDT,APPTDT1,APPTERR,ARRAY,AVGCMPL,AVGPEND,CANCEL,CANCLDT,CNSLDT,CNSLERR,CNSLIENS,CNSLT,CNSLTLNK,CNSLTS
  1. K CNSTOSVC,COMPLETE,COMPLTDT,CONIENS,DAYS2CMP,DONE,DONE2,DVBCNARR,DVBREQ,DVBRS,DVBSTAT,I,LN,NM,PATIENT,PENDING,POCLOC,POCNM,REGOPRT
  1. K REQDT,REQESTDT,REQIENS,RGNLOFC,RO,RO4RPT,ROREPRT,ROSTANM,RPTSTAT,RQSTDT,RSTAT,SITE,SSN,SSN1,STAT,TODAY,TOTCMPL,TOTPEND,VOCREC,X
  1. Q