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

DGOTHRP6.m

Go to the documentation of this file.
  1. DGOTHRP6 ;SLC/RED(LIB) - OTHD (OTHER THAN HONORABLE DISCHARGE) Reports ;May 9,2018@05:08
  1. ;;5.3;Registration;**952,977**;May 9, 2018;Build 177
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Last Edited: SHRPE/RED - June 14, 2019 09:00
  1. ;
  1. ; IA: 10103 ^XLFDT (sup) - [$$FMADD^XLFDT, $$FMTE^XLFDT , $$NOW^XLFDT]
  1. ; 10112 $$SITE^VASITE
  1. ; 10015 ^DIQ (sup)
  1. ; 10026 ^DIR (sup)
  1. ; 10061 PID^VADPT (sup)
  1. ; 10063 ^%ZTLOAD (sup)
  1. ; 10089 ^%ZISC (sup)
  1. ;
  1. Q ;Cannot be ran directly
  1. ;
  1. ;Prepares a list of patients registered in VistA since Executive Order 13822 was released (Jan. 9, 2018) who
  1. ; have an "other than honorable" discharge type and are not enrolled in VA healthcare. "
  1. ;
  1. ; Special Note: This report excludes patients with Patient Enrollment status of 'VERIFIED', I'm not completely sure this is a valid screen.
  1. ;
  1. EN ; VistA option: DG OTH POTENTIAL OTH PTS
  1. N DGSTDT,MINDTE,MAXDTE,MINDTE,MAXDTE
  1. W @IOF
  1. S MINDT=3100701,MAXDT=DT
  1. S DGSTDT=$$STARTDT(MINDT,MAXDT)
  1. I DGSTDT=0 Q
  1. ; Allow queueing
  1. K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS
  1. Q:POP
  1. I $D(IO("Q")) D Q ;Queued report settings
  1. .S ZTDESC="Potential OTH Patients Report",ZTRTN="ENQUE^DGOTHRP6"
  1. .S ZTSAVE("DGSTDT")="",ZTSAVE("ZTREQ")="@"
  1. .D ^%ZTLOAD,HOME^%ZIS
  1. .I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",!
  1. I $E(IOST)="C" D WAIT^DICD
  1. ;
  1. ENQUE ; Queued entry
  1. N DFN,DGENR,DGENR,DGSTAT,DGENDT,DGELIG,DGARRAY,PAGE,COUNT,DGDOD,DASH,DESCR,DGDISC,DGLAST,DGNAME,DGQ,PID,EXIT
  1. S DGARRAY=$NA(^TMP("DGOTHRP6",$J)) K @DGARRAY
  1. S PAGE=1,COUNT=0
  1. I $G(DGSTDT)="" S DGSTDT=3170701 ;Default start date
  1. S DFN="+" F S DFN=$O(^DPT(DFN),-1) Q:DFN<1 D
  1. . S DGENDT=$P($G(^DPT(DFN,0)),U,16) ;Date entry added to VistA
  1. . I DGENDT<DGSTDT Q ;Vista Entry was made before the start date, not need to keep looking
  1. . S DGLAST=$O(^DPT(DFN,.3216,99999),-1) ;Get the latest period of service
  1. . S DGDISC=$$GET1^DIQ(2.3216,DGLAST_","_DFN_",",".06","I")
  1. . Q:DGDISC'=4 ;Character of discharge is not OTH
  1. . Q:$D(^DGOTH(33,"B",DFN)) ;Exists as an OTH patient in file #33
  1. . S DGENR=$O(^DGEN(27.11,"C",DFN,99999999),-1)
  1. . I DGENR S DGSTAT=$$GET1^DIQ(27.11,DGENR_",",".04")
  1. . Q:$G(DGSTAT)="VERIFIED"
  1. . S DGDOD=$P($$GET1^DIQ(2,DFN_",",".351","I"),".")
  1. . D DEM^VADPT ;get patient demographics
  1. . S DGNAME=VADM(1),PID=$E(DGNAME,1)_$P($P(VADM(2),U,2),"-",3) D KVA^VADPT
  1. . S DGELIG=$$GET1^DIQ(2,DFN_",",".361") ;Current Primary Eligibility
  1. . S @DGARRAY@(DGNAME)=PID_U_DGENDT_U_DGDOD_U_DGELIG,COUNT=COUNT+1
  1. D PRTHDR,PRNTREP,QUIT
  1. Q
  1. ;
  1. PRTHDR ;
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
  1. W @IOF
  1. I PAGE=1 D
  1. . W "This report will list patients registered in VistA since Executive"
  1. . W !,"Order #13822 (dated Jan. 9, 2018) who have an 'Other Than Honorable'"
  1. . W !,"discharge type and are not currently enrolled in VA healthcare."
  1. . W !!,"The default start date is 7/1/17, you may select a different start date"
  1. . W !?3,"REPORT RUN DATE: ",$$FMTE^XLFDT(DT,10),?40,"STARTING DATE RANGE: ",$$FMTE^XLFDT(DGSTDT,10),!
  1. F DASH=1:1:75 W "="
  1. W !,"PATIENTS WITH 'OTH' DISCHARGE TYPE",?37,"FACILITY: ",$E($P($$SITE^VASITE,U,2),1,19),?68,"PAGE: ",PAGE,!
  1. F DASH=1:1:75 W "="
  1. W !,"PATIENT",?22,"PID",?30,"REG. DATE",?41,"CURRENT PRIMARY ELIG.",?65,"DATE OF",!,?65,"DEATH",!
  1. F DASH=1:1:75 W "-"
  1. Q
  1. ;
  1. PRNTREP ;Print the report
  1. N NAM
  1. I '$D(@DGARRAY) D Q
  1. .W !!," >>> No records were found using the report criteria.",!
  1. .D ASKCONT^DGOTHMG2
  1. .Q
  1. S NAM="",EXIT=0
  1. F S NAM=$O(@DGARRAY@(NAM)) Q:NAM="" D Q:EXIT
  1. .I ($E(IOST,1,2)="C-"),$Y+3>IOSL S DIR(0)="E" D ^DIR K DIR D
  1. . . I $D(DTOUT)!($D(DUOUT)) S EXIT=1 G QUIT
  1. . . S PAGE=PAGE+1 D PRTHDR
  1. . Q:EXIT
  1. . W !,$E(NAM,1,20),?22,$P(@DGARRAY@(NAM),U),?30,$$FMTE^XLFDT($P(@DGARRAY@(NAM),U,2),5),?41,$E($P(@DGARRAY@(NAM),U,4),1,23),?65,$$FMTE^XLFDT($P(@DGARRAY@(NAM),U,3),5)
  1. W:'EXIT !!,"Total number of Patients: ",COUNT
  1. I $E(IOST,1,2)="C-",'EXIT R !!?8,"End of the Report...Press Enter to Continue",X:DTIME W @IOF
  1. Q
  1. ;
  1. STARTDT(MINDT,MAXDT) ;
  1. S DESCR=""
  1. ; MINDT = earliest allowed date (required)
  1. ; returns date in internal FM format or 0 on user exit
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1. ; get min and max dates in external format
  1. S MINDTE=$$FMTE^XLFDT(3170701),MAXDTE=$$FMTE^XLFDT(MAXDT)
  1. S DIR(0)="DA^"_MINDT_":"_MAXDT_":EX"
  1. S DIR("A")="Search start date: "
  1. S DIR("B")=$$FMTE^XLFDT(3170701)
  1. S DIR("?")="Latest allowed date is TODAY"
  1. S DIR("?",1)="Earliest allowed date is "_MINDTE_"."
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 0
  1. Q +Y
  1. ;
  1. QUIT ;
  1. K @DGARRAY
  1. Q
  1. ;
  1. ;END DGOTHRP6