- 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 Feb 18, 2025@23:06:36 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