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