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

DGPPRRPT.m

Go to the documentation of this file.
  1. DGPPRRPT ;SLC/RM - PRESUMPTIVE PSYCHOSIS RECONCILIATION REPORT ; Dec 02, 2020@3:00 pm
  1. ;;5.3;Registration;**1034,1035**;Aug 13, 1993;Build 14
  1. ;
  1. ;Global References Supported by ICR# Type
  1. ;----------------- ----------------- ----------
  1. ; ^TMP($J SACC 2.3.2.5.1
  1. ;
  1. ;External References
  1. ;-------------------
  1. ; COMMA^%DTC 10000 Supported
  1. ; HOME^%ZIS 10086 Supported
  1. ; ^%ZISC 10089 Supported
  1. ; WAIT^DICD 10024 Supported
  1. ; GETS^DIQ 2056 Supported
  1. ; ^DIR 10026 Supported
  1. ; 2^VADPT 10061 Supported
  1. ; KVAR^VADPT 10061 Supported
  1. ; $$SITE^VASITE 10112 Supported
  1. ; $$FMTE^XLFDT 10103 Supported
  1. ; EN^XUTMDEVQ 1519 Supported
  1. Q
  1. ;
  1. ;Main entry point for PRESUMPTIVE PSYCHOSIS RECONCILIATION REPORT option
  1. MAIN ; Initial Interactive Processing
  1. N DGSORT ;array of report parameters
  1. N ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,%ZIS
  1. W @IOF
  1. W "PRESUMPTIVE PSYCHOSIS RECONCILIATION REPORT"
  1. W !!,"This option generates a list of patients registered under Presumptive"
  1. W !,"Psychosis authority who have had episodes of care within the user"
  1. W !,"specified date range."
  1. W !!,"Patients registered correctly using VA workaround and/or Presumptive"
  1. W !,"Psychosis Category will only be displayed in this report."
  1. W !!,"*** THIS REPORT REQUIRES 132 COLUMN margin width ***"
  1. W !!,"At the DEVICE: prompt, please accept the default value of '0;132;99999'"
  1. W !,"to avoid wrapping of data."
  1. W !!,"To include pagination, please use ';132;' for the device value.",!
  1. ;Prompt user for FROM Date of Eligibility Change
  1. I '$$DATEFROM Q
  1. ;Prompt user for TO Date of Eligibility Change
  1. I '$$DATETO Q
  1. ;prompt for device
  1. W !
  1. S %ZIS=""
  1. S %ZIS("B")="0;132;99999"
  1. S ZTSAVE("DGSORT(")=""
  1. S X="PRESUMPTIVE PSYCHOSIS RECONCILIATION REPORT"
  1. D EN^XUTMDEVQ("START^DGPPRRPT",X,.ZTSAVE,.%ZIS)
  1. D HOME^%ZIS
  1. Q
  1. ;
  1. DATEFROM() ;prompt for FROM Date of Service
  1. N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT,DGSTRTDT
  1. S DGBEGDT=3130314 ;03/14/2013 - Presumptive Psychosis legislation date
  1. S DGDIRA=" Start with Date: "
  1. S DGDIRB=$$FMTE^XLFDT(DGBEGDT)
  1. S DGDIRH="^D HELP^DGPPRRPT(1)"
  1. S DGDIRO="DA^"_DGBEGDT_":DT:EX"
  1. S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1. I DGASK>0 S DGSORT("DGBEG")=$S(DGASK<DGBEGDT:DGBEGDT,1:DGASK)
  1. Q DGASK>0
  1. ;
  1. DATETO() ;prompt for TO Date of Service
  1. N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGDTEND
  1. S DGDIRA=" End with Date : "
  1. S DGDIRB="TODAY"
  1. S DGDIRH="^D HELP^DGPPRRPT(1)"
  1. S DGDTEND=DGSORT("DGBEG")
  1. S DGDIRO="DA^"_DGSORT("DGBEG")_":DT:EX"
  1. S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
  1. I DGASK>0 S DGSORT("DGEND")=DGASK
  1. Q DGASK>0
  1. ;
  1. ANSWER(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;
  1. ; Input
  1. ; DGDIR0 - DIR(0) string
  1. ; DGDIRA - DIR("A") string
  1. ; DGDIRB - DIR("B") string
  1. ; DGDIRH - DIR("?") string
  1. ; Output
  1. ; Function Value - Internal value returned from ^DIR or -1 if user
  1. ; up-arrows, double up-arrows or the read times out.
  1. N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. I $D(DGDIR0) S DIR(0)=DGDIR0
  1. I $D(DGDIRA) M DIR("A")=DGDIRA
  1. I $G(DGDIRB)]"" S DIR("B")=DGDIRB
  1. I $D(DGDIRH) S DIR("?")=DGDIRH,DIR("??")=DGDIRH
  1. D ^DIR K DIR
  1. S Z=$S($D(DTOUT):-2,$D(DUOUT):-1,$D(DIROUT):-1,1:"")
  1. I Z="" S Z=$S(Y=-1:"",X="@":"@",1:$P(Y,U)) Q Z
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
  1. Q $S(X="@":"@",1:$P(Y,U))
  1. ;
  1. HELP(DGSEL) ;provide extended DIR("?") help text.
  1. ; Input: DGSEL - prompt var for help text word selection
  1. ; Output: none
  1. ;
  1. N DGPPDT
  1. S DGPPDT=3130314
  1. I (X="?")!(X="??") D Q
  1. . W !," Enter the VERIFIED Primary Eligibility status date"
  1. . W !," of the patient."
  1. . W ! D HELP1
  1. . W ! D HELP2
  1. . I $D(Y) K Y
  1. W !," The Date you entered is not valid."
  1. I $D(Y),Y<DGPPDT D HELP1 I $D(Y) K Y Q
  1. I $D(Y),Y>DT D HELP2 I $D(Y) K Y Q
  1. Q
  1. ;
  1. HELP1 ;
  1. W !," The earliest date that you can enter is MARCH 14, 2013."
  1. W !," Date prior to 03/14/2013 is not allowed since the"
  1. W !," Presumptive Psychosis authority was implemented on"
  1. W !," 03/14/2013."
  1. Q
  1. ;
  1. HELP2 ;
  1. W !," Date cannot be a future date."
  1. Q
  1. ;
  1. START ; compile and print report
  1. I $E(IOST)="C" D WAIT^DICD
  1. N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name where the report is run
  1. N TRM S TRM=($E(IOST)="C")
  1. N DGPPLST ;temp data storage used for report list
  1. N RECORD ;temp data storage for all records found in file #409.68,#52,#405
  1. N IBOTHSTAT
  1. S DGPPLST=$NA(^TMP($J,"DGPPMUL")) ;contains all PP data to be displayed in the report
  1. S RECORD=$NA(^TMP($J,"DGPPEOC")) ;contains all PP episodes of care data found in file #409.68,#52,#405,#45
  1. S IBOTHSTAT=$NA(^TMP($J,"DGPPRPT1")) ;contains all PP data found in file #350, and #399
  1. K @DGPPLST,@RECORD,@IBOTHSTAT
  1. D LOOP(.DGSORT,DGPPLST)
  1. D PRINTPP^DGPPRRP1(.DGSORT,DGPPLST)
  1. K @DGPPLST,@RECORD,@IBOTHSTAT
  1. D EXIT
  1. Q
  1. ;
  1. LOOP(DGSORT,DGPPLST) ;
  1. N DGDFN,VAUTD,SORTENCBY,CPT,DGPTNAME,DGPID,DGDOB,DGENCNT,DGPPWRK,DGPPCAT,DGPPARR,DGPPERR
  1. N VAEL,VADM,DGDOD,DATA,DGPEELG,DGELIGDATE,VA,DFN,I,I1,OTHER,DGPPFLGRPT
  1. S SORTENCBY=0
  1. ;PP VA Workaround
  1. ; Registration Screen <7>
  1. ; - Patient Type: SC Veteran
  1. ; - Veteran : Yes
  1. ; - Service Connected: Yes
  1. ; - Service Connected %: 0%
  1. ; - Primary Elig Code: SC LESS THAN 50%
  1. ; - Other Elig Code(s): HUMANITARIAN EMERGENCY
  1. ; Registration Screen <5>
  1. ; - VHA DIRECTIVE 1029 WNR (This is a Free text for insurance buffer entry)
  1. ; Registration Screen <11>
  1. ; - Select RATED DISABILITIES (VA): 9410 (unspecified neurosis)
  1. ; - DISABILITY %: 0
  1. ; and/or with
  1. ; Registration Screen <7>
  1. ; - PP Indicator (SHRPE 1.0)
  1. ;Note: This report will not filter the facility/division of the episodes of care where the report is run
  1. ; It will display all facility/division regardless where the report is run
  1. S VAUTD=1 ;All the divisions in the facility, since we are not prompting user to enter Division
  1. S DGPPFLGRPT=1 ;this flag will be used to determine which mumps code to execute in DGFSMOUT routine
  1. ;Loop through all PATIENT file #2
  1. S (DGDFN,CPT)=0 F S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D
  1. . S CPT=CPT+1 W:'(CPT#60000) "." ;write . every 60,000 processed records
  1. . S DGPPWRK=$$PPWRKARN^DGPPAPI(DGDFN) ;check if this patient is registered correctly using PP VA workaround settings
  1. . S DGPPCAT=$$PPINFO^DGPPAPI(DGDFN) ;check for PP category
  1. . I $P(DGPPCAT,U)'="Y" S DGPPCAT="N"
  1. . I DGPPWRK="Y"!($P(DGPPCAT,U)="Y") D ;if PP VA Workaround exist or PP Category exist, extract episode of care/inpatient/bill charges/rx
  1. . . K @RECORD ;evaluate each patient one at a time
  1. . . S (DGENCNT,I1,I)=0
  1. . . ;only collect completed encounter with STATUS=CHECKED OUT
  1. . . D CHKTREAT^DGFSMOUT(+DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),.VAUTD,0) ;check if there any past Outpatient Encounter entry in file #409.68
  1. . . D CHECKPTF^DGFSMOUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),"DGPPRPT1") ;check if there any Inpatient stay entry in file #405 OR file #45
  1. . . D CHECKIB^DGFSMOUT("DGPPRPT1",DGSORT("DGBEG"),DGSORT("DGEND")) K ^TMP($J,"DGPPRPT1") ;check if this patient has records in file #350 or file #399
  1. . . D CHECKRX^DGFSMOUT("DGPPRX52") ;check at file #52 if this patient has any RX not yet charged
  1. . . I $O(@RECORD@(""))="",DGENCNT<1 Q ;do not include patient that has no record in any of these files: 409.68, 350, 399, 52, 405, and file 45
  1. . . ;if all checking above passed, then extract patient name,PID,DOB,PP Category,Date of Service,Primary Eligibility,Other Eligibility,Date of Death
  1. . . K DATA,DGPPARR,DGPPERR D GETS^DIQ(2,DGDFN_",",".01;.0905;.361;.3611;.3612;.351","IE","DGPPARR","DGPPERR")
  1. . . Q:$D(DGPPERR)
  1. . . S DGPTNAME=$G(DGPPARR(2,DGDFN_",",.01,"I")) ;PP name
  1. . . S DGPID=$G(DGPPARR(2,DGDFN_",",.0905,"I")) ;pid
  1. . . K VAEL,VADM,DFN S DFN=DGDFN D 2^VADPT
  1. . . S DGDOB=$P(VADM(3),U) ;date of birth
  1. . . S DGDOD=$G(DGPPARR(2,DGDFN_",",.351,"I")) ;date of death
  1. . . S DGPEELG=$G(DGPPARR(2,DGDFN_",",.361,"E")) ;primary eligibility
  1. . . S DGELIGDATE=$G(DGPPARR(2,DGDFN_",",.3612,"I")) ;PE verified
  1. . . S DATA=DGPTNAME_U_DGPID_U_DGDOB_U_DGDOD_U_$P(DGPPCAT,U,2)_U_DGPEELG_U
  1. . . S @DGPPLST@(DGPTNAME,DGDFN)=DATA
  1. . . K OTHER I $D(VAEL(1))>9 S I1=0 F I=0:0 S I=$O(VAEL(1,I)) Q:'I S I1=I1+1,OTHER(I1)=$P(VAEL(1,I),"^",2)
  1. . . E S OTHER(1)="NO OTHER ELIG. IDENTIFIED",I1=1
  1. . . D KVAR^VADPT
  1. . . D EOC,EOC2
  1. Q
  1. ;
  1. EOC ;Episode of care date of service
  1. N DGDOS,DGSTATN,FILENO,CNT,EOCIEN,IBFILENO,RESULT,EOCIEN399,EOCIEN45,RECNUM,EOCIEN405,NWBL350,TRUINPT,ARY350,RXARY52,RXIEN,OUTPATARY,OUTTRUE
  1. S (I,EOCIEN45,EOCIEN,EOCIEN399,RECNUM,EOCIEN405,NWBL350,TRUINPT,RXIEN,OUTTRUE)=0
  1. S DGDOS="" F S DGDOS=$O(@RECORD@(DGDOS)) Q:DGDOS="" D
  1. . S DGSTATN="" F S DGSTATN=$O(@RECORD@(DGDOS,DGSTATN)) Q:DGSTATN="" D
  1. . . S FILENO="" F S FILENO=$O(@RECORD@(DGDOS,DGSTATN,FILENO)) Q:FILENO="" D
  1. . . . S CNT="" F S CNT=$O(@RECORD@(DGDOS,DGSTATN,FILENO,CNT)) Q:CNT="" D
  1. . . . . S (RECNUM,TRUINPT,RXIEN,OUTTRUE)=0
  1. . . . . I FILENO=350 D Q ;manually entered charges and is not linked to any file
  1. . . . . . S RESULT=$P(@RECORD@(DGDOS\1,+DGSTATN,FILENO,CNT),U,11) ;file #350 resulting from
  1. . . . . . I $P(RESULT,":")=44 K @RECORD@(DGDOS,DGSTATN,FILENO,CNT) Q ;we are not including any file #44 records as of the moment
  1. . . . . . I $P(RESULT,":")=350 D
  1. . . . . . . S NWBL350=$P($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,10),"-",2) ;same date and bill number, count them as one record
  1. . . . . . . I NWBL350="" S NWBL350=$P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,9) ;if BILL NO is null, get the IEN instead
  1. . . . . . . I '$D(ARY350(DGDOS,NWBL350)) D EOC1(FILENO) S ARY350(DGDOS,NWBL350)=""
  1. . . . . . . K @RECORD@(DGDOS,DGSTATN,FILENO,CNT)
  1. . . . . . I $P(RESULT,":")=52 D
  1. . . . . . . S RXIEN=$P($P($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,11),":",2),";") ;file #350 RXIEN from file #52
  1. . . . . . . I '$D(RXARY52(DGDOS,RXIEN)) D EOC1(FILENO) S RXARY52(DGDOS,RXIEN)=""
  1. . . . . . . K @RECORD@(DGDOS,DGSTATN,FILENO,CNT)
  1. . . . . I FILENO=52 D
  1. . . . . . S RXIEN=$P($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,7),":",2) ;file #52 RXIEN
  1. . . . . . I '$D(RXARY52(DGDOS,RXIEN)) D EOC1(FILENO) S RXARY52(DGDOS,RXIEN)=""
  1. . . . . . K @RECORD@(DGDOS,DGSTATN,FILENO,CNT)
  1. . . . . I FILENO=399 D
  1. . . . . . S RESULT=$P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,12),RXIEN=$P(RESULT,":",3)
  1. . . . . . I RESULT["PRESCRIPTION",'$D(RXARY52(DGDOS,RXIEN)) D EOC1(FILENO) S RXARY52(DGDOS,RXIEN)=""
  1. . . . . . K @RECORD@(DGDOS,DGSTATN,FILENO,CNT)
  1. . . . . I FILENO=405!(FILENO=409.68) D
  1. . . . . . I FILENO=409.68,$P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,10)'=1 D Q:OUTTRUE
  1. . . . . . . I $D(OUTPATARY($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,3),DGDOS\1)) S OUTTRUE=1 Q ;this means the record belongs to a secondary stop code, as per business owner, display and count primary and secondary stop code as one
  1. . . . . . I FILENO=405,$P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,10)>1 Q
  1. . . . . . S EOCIEN=+$P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,7) ;IEN in either file 409.68
  1. . . . . . I FILENO=405,$P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,10)<1 D ;true inpatient care record
  1. . . . . . . S TRUINPT=1
  1. . . . . . . S EOCIEN405=$P($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,8),";") ;IEN from file 405
  1. . . . . . . S EOCIEN45=$P($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,8),";",2) ;IEN from file 45
  1. . . . . . F IBFILENO=350,399 D
  1. . . . . . . I $D(@RECORD@(DGDOS\1,$S(IBFILENO=350:+DGSTATN,1:DGSTATN),IBFILENO)) D
  1. . . . . . . . S RECNUM=+$O(@RECORD@(DGDOS\1,$S(IBFILENO=350:+DGSTATN,1:DGSTATN),IBFILENO,RECNUM))
  1. . . . . . . . S RESULT=$P(@RECORD@(DGDOS\1,$S(IBFILENO=350:+DGSTATN,1:DGSTATN),IBFILENO,RECNUM),U,11) ;file #350 resulting from
  1. . . . . . . . I IBFILENO=350 D
  1. . . . . . . . . I EOCIEN=$P(RESULT,":",2) K @RECORD@(DGDOS\1,+DGSTATN,IBFILENO,RECNUM) ;from file #409.68
  1. . . . . . . . . I $P(RESULT,":")=45,EOCIEN45=$P(RESULT,":",2) K @RECORD@(DGDOS\1,+DGSTATN,IBFILENO,RECNUM) ;from file #45
  1. . . . . . . . . I $P(RESULT,":")=405,EOCIEN405=$P(RESULT,":",2) K @RECORD@(DGDOS\1,+DGSTATN,IBFILENO,RECNUM) ;from file #405
  1. . . . . . . . I IBFILENO=399 D
  1. . . . . . . . . S EOCIEN399=+$P($G(@RECORD@(DGDOS\1,DGSTATN,IBFILENO,RECNUM)),U,17) ;IEN in either file 405 or file 409.68
  1. . . . . . . . . I EOCIEN=EOCIEN399!(EOCIEN45=EOCIEN399) K @RECORD@(DGDOS\1,DGSTATN,IBFILENO,RECNUM)
  1. . . . . . . . . I +EOCIEN<1,EOCIEN45=EOCIEN399 K @RECORD@(DGDOS\1,DGSTATN,IBFILENO,RECNUM)
  1. . . . . . D EOC1(FILENO)
  1. ;check if there are any left over from file #350 or file #399. These records are not linked to any record in either file #409.68, #405, or file #45
  1. I $O(@RECORD@(""))'="" D RECORD
  1. K ARY350,RXARY52,OUTPATARY
  1. Q
  1. ;
  1. EOC1(FILE) ;capture the date of service
  1. S I=I+1
  1. S TRUINPT=$S(+TRUINPT<1:"",1:"*")
  1. S @DGPPLST@(DGPTNAME,DGDFN,DGDOS\1,I,"OTHER",FILE,DGSTATN)=TRUINPT_DGDOS
  1. I FILENO=405!(FILENO=409.68) S OUTPATARY($P(@RECORD@(DGDOS,DGSTATN,FILENO,CNT),U,3),DGDOS\1)=""
  1. Q
  1. ;
  1. EOC2 ;capture the other eligibilities if there are any
  1. N DGDOS,DGSTATN,FILENO,II,CNTR
  1. I I=I1!(I>I1) D EOC3 Q ;the total number of date of service is equal or more to the number of other eligibilities that the patient have
  1. I I<I1 D ;the other eligibilities is more than the date of service
  1. . F CNTR=1:1:I1 D EOC4
  1. Q
  1. ;
  1. EOC3 ;
  1. S DGDOS="" F S DGDOS=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS)) Q:DGDOS="" D
  1. . S II="" F S II=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,II)) Q:II="" D
  1. . . S FILENO="" F S FILENO=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,II,"OTHER",FILENO)) Q:FILENO="" D
  1. . . . S DGSTATN="" F S DGSTATN=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,II,"OTHER",FILENO,DGSTATN)) Q:DGSTATN="" D
  1. . . . . I $D(OTHER(II)) S $P(@DGPPLST@(DGPTNAME,DGDFN,DGDOS\1,II,"OTHER",FILENO,DGSTATN),U,2)=OTHER(II)
  1. Q
  1. ;
  1. EOC4 ;
  1. N RECNT
  1. S RECNT=0
  1. S DGDOS="" F S DGDOS=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS)) Q:DGDOS="" D
  1. . I '$D(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,CNTR)),CNTR>I D Q
  1. . . S FILENO=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,I,"OTHER",""))
  1. . . Q:FILENO=""
  1. . . S DGSTATN=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,I,"OTHER",FILENO,"")),RECNT=1
  1. . . S @DGPPLST@(DGPTNAME,DGDFN,DGDOS\1,CNTR,"OTHER",FILENO,DGSTATN)=""_U_OTHER(CNTR)
  1. . S FILENO="" F S FILENO=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,CNTR,"OTHER",FILENO)) Q:FILENO="" D
  1. . . S DGSTATN="" F S DGSTATN=$O(@DGPPLST@(DGPTNAME,DGDFN,DGDOS,CNTR,"OTHER",FILENO,DGSTATN)) Q:DGSTATN="" D
  1. . . . I $D(@DGPPLST@(DGPTNAME,DGDFN,DGDOS\1,CNTR)) S RECNT=1,$P(@DGPPLST@(DGPTNAME,DGDFN,DGDOS\1,CNTR,"OTHER",FILENO,DGSTATN),U,2)=OTHER(CNTR)
  1. Q
  1. ;
  1. RECORD ;display those records that are not linked to any IB charges
  1. N DOS,DGSTATN,CNT,FILENO
  1. F FILENO=52,350,399 D
  1. . S DGDOS="" F S DGDOS=$O(@RECORD@(DGDOS)) Q:DGDOS="" D
  1. . . S DGSTATN="" F S DGSTATN=$O(@RECORD@(DGDOS,DGSTATN)) Q:DGSTATN="" D
  1. . . . S CNT="" F S CNT=$O(@RECORD@(DGDOS,DGSTATN,FILENO,CNT)) Q:CNT="" D
  1. . . . . D EOC1(FILENO) K @RECORD@(DGDOS,DGSTATN,FILENO,CNT)
  1. Q
  1. ;
  1. CHKDATE(DATE,BEGDT,ENDDT) ;check if dates fall within the Begin and End dates
  1. Q BEGDT<=DATE&(ENDDT>=DATE)
  1. ;
  1. EXIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@" ;tell TaskMan to delete Task log entry
  1. I '$D(ZTQUEUED) D
  1. . I 'TRM,$Y>0 W @IOF
  1. . K %ZIS,POP
  1. . D ^%ZISC,HOME^%ZIS
  1. Q
  1. ;
  1. DOLLAR(X) ; Function to return a formatted dollar amount.
  1. I $G(X)="" Q ""
  1. N X2,X3
  1. S X2="2$",X3=0
  1. D COMMA^%DTC
  1. Q X
  1. ;