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

DGOTHRP5.m

Go to the documentation of this file.
  1. DGOTHRP5 ;SLC/RED,RM - OTHD (OTHER THAN HONORABLE DISCHARGE) Reports ;April 03,2019@10:16
  1. ;;5.3;Registration;**952,977**;4/30/19;Build 177
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;IA's
  1. ; 10015 Sup GETS^DIQ
  1. ; 10103 Sup ^XLFDT: $$FMTE, $$NOW
  1. ; 10026 Sup ^DIR
  1. ; 10063 Sup ^%ZTLOAD
  1. ; 10104 Sup $$CJ^XLFSTR
  1. ; 10024 Sup WAIT^DICD
  1. ; 10112 Sup $$SITE^VASITE
  1. ; 10003 Sup %DT
  1. ; 10089 Sup %ZISC
  1. ;
  1. Q ; No direct access
  1. ;
  1. EN ;entry point from Menu Option: DGOTH OTH-90 STATUS REPORTS
  1. N DGIEN33,NAME,PID,PROMPT,DGRTYP,DGRET,PAGE,DGDTFRM,DGDTTO,DGARR,DGERR,DGDIV,NAME,PID,ZTSK,DGDTFRMTO,DASH,DGREM,SET,EXIT
  1. N ZTSAVE ;open array reference of input parameters used by tasking
  1. N ZTDESC ;contains the free-text description of your task that you passed to the Program Interface
  1. N ZTQUEUED ;background execution
  1. N ZTREQ ;post-execution
  1. N ZTSTOP
  1. N ZTRTN
  1. N ZTSK
  1. N VAUTD,Y ; variables for DIVISION^VAUTOMA
  1. N DGSORT ;array or report parameters
  1. N DGENCTR ;array for the outpatient encounter
  1. N HERE
  1. ;check for database
  1. ;DG*5.3*977 OTH-EXT
  1. I '+$O(^DGOTH(33,"B","")) W !,$$CJ^XLFSTR(">>> No OTH-90 records have been found. <<<",80) D ASKCONT^DGOTHMG2 Q
  1. S DGRET=$NA(^TMP("DGOTHRP5",$J)) K @DGRET,DGSORT,VAUTD
  1. S (EXIT,DGIEN33,PAGE)=0
  1. W @IOF
  1. W !,"OTH 90-DAY PERIOD AUTHORIZATION REPORT"
  1. W !!,"This option generates a report that prints a listing of OTH-90 patients who"
  1. W !,"have an Outpatient Encounter with STATUS=CHECKED OUT for Clinic(s) associated"
  1. W !,"with the selected Division(s) within the user-specified date range in which"
  1. W !,"their 90-Day period of care has been APPROVED, PENDING or DENIED."
  1. S PROMPT="Please select OTH-90 Authorization report type",SET="S^1:Approved;2:Pending;3:Denied"
  1. S DGRTYP=$$SELECT(PROMPT,SET)
  1. I 'Y G OUT ;quit if no selection
  1. I Y S DGRTYP=$S(Y=1:"APPROV",Y=2:"PEND",1:"DENIED")
  1. S DGDTFRMTO=$$DTFRMTO("Select dates")
  1. Q:DGDTFRMTO=0
  1. ;
  1. ;DG*5.3*977 OTH-EXT
  1. ;prompt user to select DIVISION
  1. W !!,"Please select divisions to include in the report"
  1. I '$$SELDIV^DGOTHRP1 Q
  1. ;DGSORT("DIVISION")=0 -- user only select one division
  1. ;DGSORT("DIVISION")=1 -- user select ALL division
  1. ;DGSORT("DIVISION")>1 -- user select multiple division but not all
  1. ;if user selected division is many or all but not one
  1. ;prompt user on how the report will be sorted
  1. I DGSORT("DIVISION")>0,'$$SORTRPT^DGOTHRP1 Q
  1. I DGSORT("DIVISION")=0 S DGSORT("REPORT")="1^Patient Name" ;default to sort report by divisions
  1. ;prompt for device
  1. W !
  1. S ZTSAVE("DGSORT(")=""
  1. S X="OTH-90 AUTHORIZATION REPORT"
  1. D EN^XUTMDEVQ("DQ^DGOTHRP5",X,.ZTSAVE)
  1. D HOME^%ZIS
  1. Q
  1. ;
  1. DQ ;
  1. I $E(IOST)="C" D WAIT^DICD
  1. S HERE=$$SITE^VASITE ;extract the IEN and facility name
  1. N TRM S TRM=($E(IOST)="C")
  1. N DGDFN
  1. S DGDFN=""
  1. F S DGDFN=$O(^DGOTH(33,"B",DGDFN)) Q:DGDFN="" D
  1. . ; Start search logic here and then head to reports
  1. . S DGIEN33=$$HASENTRY^DGOTHD2(DGDFN)
  1. . K DGARR,DGERR D GETS^DIQ(33,DGIEN33_",",".01;.02;.06;.07;1*","EI","DGARR","DGERR")
  1. . Q:$D(DGERR)
  1. . Q:DGARR(33,DGIEN33_",",.02,"I")=0
  1. . ;DG*5.3*977 OTH-EXT
  1. . ;Patient's primary eligibility code is no longer EXPANDED MH CARE NON-ENROLLEE
  1. . Q:$$ISOTHD^DGOTHD(DGDFN)=0
  1. . ;Patient's current MH CARE TYPE is no longer OTH-90
  1. . Q:'$$ISOTH90^DGOTHRP2(DGDFN)
  1. . N NAME,PID,DGDIV S PID=$$GET1^DIQ(2,DGARR(33,DGIEN33_",",.01,"I"),".0905","E"),NAME=DGARR(33,DGIEN33_",",.01,"E")
  1. . D @DGRTYP
  1. D PRINT,OUT
  1. Q
  1. ;
  1. APPROV ;Approved authorizations
  1. N DG90A,DGRES9,DG365,DGDATA
  1. D CLOCK^DGOTHINQ(DGIEN33)
  1. Q:'$D(DG90A(2))
  1. S DG365=$$LASTPRD^DGOTHUT1(DGIEN33)
  1. N DGPER S DGPER=1 F DGPER=2:1:$P(DG365,U,3) D
  1. . S DGDATA=$$GETAUTH^DGOTHUT1(DGIEN33,$P(DG365,U),DGPER),DGDIV=$P(DGDATA,U,9)
  1. . Q:$P(DGDATA,U,8)="" ;Not authorized yet
  1. . I DGDIV="" S DGDIV="UNKN"
  1. . I $P(DGDATA,U,3)<DGDTFRM!($P(DGDATA,U,3)>DGDTTO) Q ;Not within the date range
  1. . Q:'$$CHECKOE() ;check if there any Outpatient Encounter entry for this patient
  1. . D BUILD
  1. Q
  1. ;
  1. CHECKOE() ;check if there any Outpatient Encounter entry for this patient
  1. K DGENCTR
  1. D CHKTREAT^DGPPRP1(.DGENCTR,+DGDFN,DGDTFRM,DGDTTO,.VAUTD)
  1. Q $S('$D(DGENCTR):0,1:1)
  1. ;
  1. BUILD ;Build data either by Division or Facility
  1. N DGDIVOE,DGSDT,TMPDIV
  1. S (DGDIVOE,DGSDT,TMPDIV)=""
  1. F S DGDIVOE=$O(DGENCTR(DGDIVOE)) Q:DGDIVOE="" D
  1. . F S DGSDT=$O(DGENCTR(DGDIVOE,DGSDT)) Q:DGSDT="" D
  1. . . S TMPDIV=$P(DGENCTR(DGDIVOE,DGSDT),U,2)
  1. . . I TMPDIV="" S TMPDIV=$S($P(^DG(40.8,DGDIVOE,0),U,2)="":"UNKNOWN",1:$P(^DG(40.8,DGDIVOE,0),U,2))
  1. . . I TMPDIV["UNKNOWN" S DGSORT("DIVISION",DGDIVOE,TMPDIV)=$P(DGENCTR(DGDIVOE,DGSDT),U)
  1. . . I 1[$P(DGSORT("REPORT"),U),'$D(@DGRET@(TMPDIV)) S @DGRET@(TMPDIV)=DGENCTR(DGDIVOE,DGSDT)
  1. . . I DGRTYP="APPROV" D
  1. . . . S @DGRET@(TMPDIV,NAME,DGPER)=NAME_U_PID_U_$$FMTE^XLFDT($P($P(DGDATA,U,4),"."),"5Z")_U_$$FMTE^XLFDT($P($P(DGDATA,U,5),"."),"5Z")_U_$$FMTE^XLFDT($P($P(DGDATA,U,3),"."),"5Z")_U_$P(DGDATA,U,8)
  1. . . I DGRTYP="PEND" D
  1. . . . S @DGRET@(TMPDIV,NAME)=NAME_U_PID_U_$$FMTE^XLFDT($P(DGRES9,U,2),"5Z")_U_DGREM
  1. . . I DGRTYP="DENIED" D
  1. . . . S @DGRET@(TMPDIV,NAME,SEQ)=NAME_U_PID_U_$$FMTE^XLFDT($P(DGRES,U,2),"5Z")_U_DGREAS
  1. Q
  1. ;
  1. PEND ; Pending Requests
  1. Q:DGARR(33,DGIEN33_",",.07,"I")=""
  1. N DG90A,DGRES9 S DGRES9=$$GETPEND^DGOTHUT1(DGARR(33,DGIEN33_",",.01,"I"))
  1. Q:DGRES9<1
  1. S DGDIV=$P(DGRES9,U,5),DGREM=$$FMDIFF^XLFDT(DT,$P(DGRES9,U,2),1)
  1. I $P(DGRES9,U,2)<DGDTFRM!($P(DGRES9,U,2)>DGDTTO) Q ;Not within the date range
  1. Q:'$$CHECKOE() ;check if there any Outpatient Encounter entry for this patient
  1. D BUILD
  1. Q
  1. ;
  1. DENIED ;Denied requests
  1. N SEQ,DGRES
  1. Q:'$D(^DGOTH(33,DGIEN33,3))
  1. N DGLDEN,DGDIV,DGREAS S DGLDEN=999,DGLDEN=$O(^DGOTH(33,DGIEN33,3,"B",DGLDEN),-1)
  1. F SEQ=1:1:DGLDEN D
  1. . S DGRES=$$GETDEN^DGOTHUT1(DGIEN33,SEQ)
  1. . Q:DGRES<1
  1. . I $P(DGRES,U,2)<DGDTFRM!($P(DGRES,U,2)>DGDTTO) Q ;Not within the date range
  1. . Q:'$$CHECKOE() ;check if there any Outpatient Encounter entry for this patient
  1. . S DGDIV=$P(DGRES,U,6),DGREAS=$P(DGRES,U,3)
  1. . D BUILD
  1. Q
  1. ;
  1. HDR ; Print page header
  1. S PAGE=$G(PAGE)+1
  1. W @IOF W ?15,"Other Than Honorable '",$S(DGRTYP="APPROV":"APPROVED",DGRTYP="PEND":"PENDING",1:"DENIED"),"' Authorizations",?70,"Page: ",PAGE
  1. W !?15,"Selected date range: ",$$FMTE^XLFDT(DGDTFRM,"5Z")," to ",$$FMTE^XLFDT(DGDTTO,"5Z"),!
  1. W "Facility: "_$P(HERE,U,2),?51,"Sorted By: ",$P(DGSORT("REPORT"),U,2),!
  1. F DASH=1:1:80 W "-"
  1. I DGRTYP="APPROV" D
  1. . W !,"Name",?23,"PID",?30,"Date Req.",?42,"Date Auth.",?54,"90-Day",?66,"Authorized By"
  1. . W !,?30,"Submitted",?42,"Received",?54,"Start DT",!
  1. I DGRTYP="PEND" W !,"Name",?33,"PID",?41,"Pending Auth.",?58,"# of Days Auth.",!,?41,"Request Date",?58,"is Pending",!
  1. I DGRTYP="DENIED" W !,"Name",?24,"PID",?31,"Date Request",?45,"Authorization Comment",!,?31,"Submitted",!
  1. F DASH=1:1:80 W "-"
  1. ;
  1. Q
  1. ;
  1. PRINT ;Print out results
  1. N DGFAC,DGOLDIV,FACILITY,DGPTLIST,DGOEIEN
  1. S DGOLDIV=""
  1. K DGPTLIST
  1. I '$D(@DGRET) D HDR W !!," >>> No records were found using the report criteria.",! G OUT
  1. I 2[$P(DGSORT("REPORT"),U) D
  1. . D HDR
  1. . S DGFAC=0 F S DGFAC=$O(@DGRET@(DGFAC)) Q:DGFAC=""!(EXIT) D PRINT1 Q:EXIT
  1. E D
  1. . S DGOEIEN="" F S DGOEIEN=$O(DGSORT("DIVISION",DGOEIEN)) Q:DGOEIEN="" D Q:EXIT
  1. . . S DGFAC="" F S DGFAC=$O(DGSORT("DIVISION",DGOEIEN,DGFAC)) Q:DGFAC="" D Q:EXIT
  1. . . . D HDR,DVISION
  1. . . . I '$D(@DGRET@(DGFAC)) D Q
  1. . . . . W !," >>> No records were found for this Division.",!!
  1. . . . . I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
  1. . . . . . I $D(DTOUT)!($D(DUOUT)) S EXIT=1 G OUT
  1. . . . D PRINT1
  1. Q:EXIT
  1. I $E(IOST,1,2)="C-" R !!?8,"End of the Report...Press Enter to Continue",X:DTIME W @IOF
  1. Q
  1. ;
  1. ;DG*5.3*977 OTH-EXT
  1. DVISION ;
  1. W "Division: ",DGSORT("DIVISION",DGOEIEN,DGFAC)_" ("_DGFAC_")",!
  1. Q
  1. ;
  1. PRINT1 ;Print out results
  1. N DGOLDNM,SEQ
  1. S DGOLDNM=""
  1. N NAME,DGPER
  1. S NAME="" F S NAME=$O(@DGRET@(DGFAC,NAME)) Q:NAME="" D
  1. . I DGRTYP="APPROV" D Q
  1. . . S DGPER=0 F S DGPER=$O(@DGRET@(DGFAC,NAME,DGPER)) Q:DGPER="" D
  1. . . . I $Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
  1. . . . . I $D(DTOUT)!($D(DUOUT)) S EXIT=1 G OUT
  1. . . . . D HDR
  1. . . . . I 1[$P(DGSORT("REPORT"),U) D DVISION
  1. . . . . I DGOLDNM=NAME W !,$E(NAME,1,22),?23,$P(@DGRET@(DGFAC,NAME,DGPER),U,2)
  1. . . . I 'EXIT D
  1. . . . . ;do not display the patient's name twice is sort by facility is selected
  1. . . . . I 2[$P(DGSORT("REPORT"),U),$D(DGPTLIST(NAME,DGPER)) Q
  1. . . . . ;display the patient name and PID once only
  1. . . . . I DGOLDNM'=NAME W !,$E(NAME,1,22),?23,$P(@DGRET@(DGFAC,NAME,DGPER),U,2) S DGOLDNM=NAME
  1. . . . . W ?30,$P(@DGRET@(DGFAC,NAME,DGPER),U,3),?42,$P(@DGRET@(DGFAC,NAME,DGPER),U,4),?54,$P(@DGRET@(DGFAC,NAME,DGPER),U,5)
  1. . . . . W ?66,$E($P(@DGRET@(DGFAC,NAME,DGPER),U,6),1,14),!
  1. . . . I 2[$P(DGSORT("REPORT"),U),'$D(DGPTLIST(NAME,DGPER)) S DGPTLIST(NAME,DGPER)=""
  1. . I DGRTYP="PEND" D Q
  1. . . I $Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
  1. . . . I $D(DTOUT)!($D(DUOUT)) S EXIT=1 G OUT
  1. . . . D HDR
  1. . . I 'EXIT D
  1. . . . ;do not display the patient's name twice is sort by facility is selected
  1. . . . I 2[$P(DGSORT("REPORT"),U),$D(DGPTLIST(NAME)) Q
  1. . . . W !,$E(NAME,1,30),?33,$P(@DGRET@(DGFAC,NAME),U,2),?41,$P(@DGRET@(DGFAC,NAME),U,3),?60,$J($P(@DGRET@(DGFAC,NAME),U,4),5)
  1. . . I 2[$P(DGSORT("REPORT"),U),'$D(DGPTLIST(NAME)) S DGPTLIST(NAME)=""
  1. . I DGRTYP="DENIED" D Q
  1. . . S SEQ=0 F S SEQ=$O(@DGRET@(DGFAC,NAME,SEQ)) Q:SEQ="" D
  1. . . . I $Y+3>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" D ^DIR K DIR D
  1. . . . . I $D(DTOUT)!($D(DUOUT)) S EXIT=1 G OUT
  1. . . . . D HDR
  1. . . . I 'EXIT D
  1. . . . . ;do not display the patient's name twice is sort by facility is selected
  1. . . . . I 2[$P(DGSORT("REPORT"),U),$D(DGPTLIST(NAME,SEQ)) Q
  1. . . . . ;display the patient name and PID once only
  1. . . . . I DGOLDNM'=NAME W !,$E(NAME,1,22),?24,$P(@DGRET@(DGFAC,NAME,SEQ),U,2) S DGOLDNM=NAME
  1. . . . . W ?31,$P(@DGRET@(DGFAC,NAME,SEQ),U,3),?45,$E($P(@DGRET@(DGFAC,NAME,SEQ),U,4),1,35),!
  1. . . . I 2[$P(DGSORT("REPORT"),U),'$D(DGPTLIST(NAME)) S DGPTLIST(NAME,SEQ)=""
  1. Q:EXIT
  1. I 1[$P(DGSORT("REPORT"),U) I ($E(IOST,1,2)="C-")&(IO=IO(0)) S DIR(0)="E" W ! D ^DIR K DIR D
  1. . I $D(DTOUT)!($D(DUOUT)) S EXIT=1 G OUT W !
  1. Q
  1. ;
  1. DTFRMTO(PROMPT) ;Get from and to dates
  1. N %DT,Y,X,DTOUT,OUT,DIRUT,DUOUT,DIROUT,STATUS,STDT,STATUS
  1. ;INPUT ; PROMPT - Message to display prior to prompting for dates
  1. ;OUTPUT: 1^BEGDT^ENDDT - Data found
  1. ; 0 - User up arrowed or timed out
  1. ;If they want to show first available date for that set of Status, use this sub
  1. INDT ;
  1. S OUT=0
  1. S DIR(0)="DO^"_DT_":"_DT_":EX"
  1. S %DT="AEX",%DT("A")="Starting date - From: " ;Enter Beginning Date: "
  1. W ! D ^%DT K %DT
  1. I Y<0 W !!,"No Date selected, quitting. ",!! Q OUT ;Quit if user time out or didn't enter valid date
  1. I Y>DT W !!,"Future dates are not allowed, please re-enter" K Y,%DT G INDT ;Future dates not allowed
  1. S DGDTFRM=+Y
  1. TODT S %DT="AEX",%DT("A")=" Ending date - TO: ",%DT("B")="T" ; Get end date, default is "TODAY"
  1. D ^%DT K %DT
  1. ;Quit if user time out or didn't enter valid date
  1. I Y<0 W !!,"No Date selected, quitting. ",!! Q OUT
  1. I Y<DGDTFRM W !!,"Ending date must be greater than or equal to the start date",!! K Y,%DT G TODT
  1. S DGDTTO=+Y,OUT=1_U_DGDTFRM_U_DGDTTO
  1. ;Switch dates if Begin Date is more recent than End Date
  1. S:DGDTFRM>DGDTTO OUT=1_U_DGDTTO_U_DGDTFRM
  1. Q OUT
  1. ;
  1. SELECT(PROMPT,SET) ; prompts for a report type
  1. ;INPUT:
  1. S DIR(0)=SET,DIR("A")=PROMPT,DIR("B")=1,DIR("?")="^D HELP^DGOTHRP5(1)",DIR("??")=DIR("?") D ^DIR K DIR
  1. Q:Y<0 OUT
  1. Q Y
  1. ;
  1. OUT ; KILL RETURN ARRAY QUIT
  1. D ^%ZISC
  1. K @DGRET
  1. Q
  1. ;
  1. ;DG*5.3*977 OTH-EXT
  1. HELP(DGSEL) ;OTH-90 Authorization Report help text
  1. I DGSEL=1 D
  1. . W !," Please ENTER:",!
  1. . D TEXT
  1. . W !," 1 = That have been 'APPROVED' for an additional 90-Day"
  1. . W !," period of care."
  1. . W !," 2 = Whose request for an additional 90-Day period of"
  1. . W !," care is waiting to be approved or denied."
  1. . W !," 3 = Whose request for an additional 90-Day period of"
  1. . W !," care has been DENIED."
  1. Q
  1. ;
  1. ;DG*5.3*977 OTH-EXT
  1. TEXT ;
  1. W !," If you wish to print a list(s) of OTH-90 MH Care"
  1. W !," patient who have an Outpatient Encounter with"
  1. W !," STATUS=CHECKED OUT for selected Division within"
  1. W !," the user-specified date range.",!
  1. Q
  1. ;