- DVBAADRP ;ALB/GTS-557/THM-AMIE COMPLETE ADMISSION RPT ; 1/22/91 1:19 PM
- ;;2.7;AMIE;**17,42,53,108,149,185**;Apr 10, 1995;Build 18
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- N DVBGUI
- S DVBGUI=0
- K ^TMP($J) G TERM
- Q
- ;
- ENBROKER(Y) ;
- ; Returns some info for the CAPRI GUI to display prior
- ; to the user running this report
- N DVBGUI
- S DVBGUI=1
- K ^TMP($J)
- D HOME^%ZIS K NOASK,QUIT1
- D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
- ;
- S Y(1)="VARO COMPLETE ADMISSION REPORT" S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
- S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
- S Y(2)=HEAD1,Y(3)=""
- S Y(4)="Please enter dates for search, oldest date first, most recent date last."
- S Y=$P(DTAR,U,3) X ^DD("DD")
- S Y(5)=""
- S Y(6)="Last report was run on "_Y
- Q
- ;
- ;Input: DVBADLMTR - Indicates if report should be delimited (Optional)
- ENBROKE2(MSG,BDATE,EDATE,RO,RONUM,DVBADLMTR) ;
- ; This is the entry point to run the actual report from
- ; the CAPRI GUI.
- N DVBHFS,DVBERR,DVBGUI,I,DVBADHDR
- K ^TMP("DVBA",$J)
- S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:","),DVBADHDR=0
- S DVBGUI=1,DVBERR=0,DVBHFS=$$HFS^DVBAB82()
- S X=BDATE,Y=EDATE
- ; DVBA*2.7*108 - Correct next line. CAPRI GUI already adds 1 to EDATE
- ; S BDATE=BDATE-.5,EDATE=EDATE+.5
- S BDATE=BDATE-.5,EDATE=EDATE-.5
- K ^TMP($J)
- D HOME^%ZIS K NOASK,QUIT1
- D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
- ;
- S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
- I $D(X) D
- . G:X=""!(Y<0) KILL S %ZIS="AEQ" D ^%ZIS K %ZIS
- D HFSOPEN^DVBAB82("DVBRP",DVBHFS,"W") I DVBERR D END^DVBAB82 Q
- I POP K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
- U IO
- D DEQUE
- D END^DVBAB82
- Q
- SET Q:'$D(^DPT(DA,0)) S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
- S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
- Q
- ;
- PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),DFN=DA,QUIT1=1 D ADM^DVBAVDPT
- S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
- S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
- D:($G(DVBADLMTR)'="") PRINTD
- D:($G(DVBADLMTR)="") PRINTND
- Q
- ;
- PRINTND ;print non-delimited admission inq report
- W:(IOST?1"C-".E!($D(DVBAON2))) @IOF
- I DVBGUI=0 W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!!
- I DVBGUI=1 W !!
- W ?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!,?8,"Admission Date:",?26,ADMDT,!,?3,"Admitting Diagnosis:",?26,DIAG,!
- W ?8,"Discharge Date:",?26,DCHGDT,!,?11,"Bed Service:",?26,BEDSEC,!,?13,"Recv A&A?:",?26,$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),!
- W ?14,"Pension?:",?26,$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),! D ELIG^DVBAVDPT I IOST'?1"C-".E S DVBAON2=""
- I IOST?1"C-".E DO
- .I ($O(^TMP($J,XCN))'=""!($O(^TMP($J,XCN,CFLOC))'=""!($O(^TMP($J,XCN,CFLOC,ADM))'=""!($O(^TMP($J,XCN,CFLOC,ADM,DA))'="")))) DO
- ..I DVBGUI=0 D
- ...W *7,!,"Press RETURN to continue or ""^"" to stop "
- ...R ANS:DTIME
- ...S:ANS=U!('$T) QUIT=1
- ...I '$T S DVBAQUIT=1
- .I ($O(^TMP($J,XCN))=""&($O(^TMP($J,XCN,CFLOC))=""&($O(^TMP($J,XCN,CFLOC,ADM))=""&($O(^TMP($J,XCN,CFLOC,ADM,DA))="")))) DO
- ..I DVBGUI=0 D
- ...W *7,!,"Press RETURN to continue "
- ...R ANS:DTIME
- Q
- ;
- PRINTD ;print delimited admission inq report
- ;eligibility logic copied from ELIG^DVBAVDPT
- N ELIG,INCMP
- S ELIG=DVBAELIG,INCMP=""
- I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
- I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
- I INCMP]"",ELIG]"" S ELIG=ELIG_", "_INCMP
- D DEM^VADPT I $G(SSN)'="" S SSN=$P($G(VADM(2)),U,2)
- D:('DVBADHDR) COLHDR
- W !,""""_PNAM_""""_DVBADLMTR_$C(160)_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR_""""_DIAG_""""_DVBADLMTR
- W DCHGDT_DVBADLMTR_""""_BEDSEC_""""_DVBADLMTR_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR
- W $S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR_""""_ELIG_""""
- Q
- ;
- PRINT U IO S QUIT="" K MA,MB
- S XCN="" F M=0:0 S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1) S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1) D PRINT1
- Q
- PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1) S DA="" F L=0:0 S DA=$O(^TMP($J,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1) S DATA=^(DA) D PRINTB
- Q
- ;
- TERM D HOME^%ZIS K NOASK,QUIT1
- D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL
- ;
- SETUP W @IOF,!,"VARO COMPLETE ADMISSION REPORT" S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
- S HEAD="TOTAL ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0)
- W !,HEAD1
- EN1 W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,3) X ^DD("DD") W Y,!!
- D DATE^DVBAUTIL
- G:X=""!(Y<0) KILL S %ZIS="AEQ" D ^%ZIS K %ZIS
- I POP K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
- ;
- QUEUE I $D(IO("Q")) S ZTRTN="DEQUE^DVBAADRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE ADMISSION REPORT" F I="BDATE","EDATE","HEAD","HEAD1","RO","RONUM","FDT(0)","NOASK" S ZTSAVE(I)=""
- I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL
- ;
- GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="") W:(('$D(NOASK))&($G(DVBADLMTR)="")) "." F DA=0:0 S DA=$O(^DGPM("AMV1",MA,DA)) Q:DA="" F MB=0:0 S MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB="" I MA'>EDATE D SET
- I '$D(^TMP($J)) D H 2 G KILL
- .U IO
- .W:($G(DVBADLMTR)="") !!,*7
- .W "No data found for parameters entered.",!!
- W:(($G(DVBGUI)=1)&($G(DVBADLMTR)="")) !,HEAD,!,HEAD1,!
- I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
- ;
- KILL ;
- D ^%ZISC S X=3 K DVBAON2,DCHPTR,M,Y,J D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
- ;
- DEQUE K ^TMP($J) G GO
- ;
- COLHDR ;Column header for delimited report
- W "Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
- W "Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR_"Admitting Diagnosis"_DVBADLMTR
- W "Discharge Date"_DVBADLMTR_"Bed Service"_DVBADLMTR_"Recv A&A?"_DVBADLMTR
- W "Pension?"_DVBADLMTR_"Eligibility Data"
- S DVBADHDR=1 ;set so header info only printed once
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAADRP 6237 printed Feb 18, 2025@23:06:38 Page 2
- DVBAADRP ;ALB/GTS-557/THM-AMIE COMPLETE ADMISSION RPT ; 1/22/91 1:19 PM
- +1 ;;2.7;AMIE;**17,42,53,108,149,185**;Apr 10, 1995;Build 18
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 NEW DVBGUI
- +5 SET DVBGUI=0
- +6 KILL ^TMP($JOB)
- GOTO TERM
- +7 QUIT
- +8 ;
- ENBROKER(Y) ;
- +1 ; Returns some info for the CAPRI GUI to display prior
- +2 ; to the user running this report
- +3 NEW DVBGUI
- +4 SET DVBGUI=1
- +5 KILL ^TMP($JOB)
- +6 DO HOME^%ZIS
- KILL NOASK,QUIT1
- +7 DO NOPARM^DVBAUTL2
- if $DATA(DVBAQUIT)
- GOTO KILL^DVBAUTIL
- +8 ;
- +9 SET Y(1)="VARO COMPLETE ADMISSION REPORT"
- SET DTAR=^DVB(396.1,1,0)
- SET FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
- +10 SET HEAD="TOTAL ADMISSION REPORT"
- SET HEAD1="FOR "_$PIECE(DTAR,U,1)_" ON "_FDT(0)
- +11 SET Y(2)=HEAD1
- SET Y(3)=""
- +12 SET Y(4)="Please enter dates for search, oldest date first, most recent date last."
- +13 SET Y=$PIECE(DTAR,U,3)
- XECUTE ^DD("DD")
- +14 SET Y(5)=""
- +15 SET Y(6)="Last report was run on "_Y
- +16 QUIT
- +17 ;
- +18 ;Input: DVBADLMTR - Indicates if report should be delimited (Optional)
- ENBROKE2(MSG,BDATE,EDATE,RO,RONUM,DVBADLMTR) ;
- +1 ; This is the entry point to run the actual report from
- +2 ; the CAPRI GUI.
- +3 NEW DVBHFS,DVBERR,DVBGUI,I,DVBADHDR
- +4 KILL ^TMP("DVBA",$JOB)
- +5 SET DVBADLMTR=$SELECT('+$GET(DVBADLMTR):"",1:",")
- SET DVBADHDR=0
- +6 SET DVBGUI=1
- SET DVBERR=0
- SET DVBHFS=$$HFS^DVBAB82()
- +7 SET X=BDATE
- SET Y=EDATE
- +8 ; DVBA*2.7*108 - Correct next line. CAPRI GUI already adds 1 to EDATE
- +9 ; S BDATE=BDATE-.5,EDATE=EDATE+.5
- +10 SET BDATE=BDATE-.5
- SET EDATE=EDATE-.5
- +11 KILL ^TMP($JOB)
- +12 DO HOME^%ZIS
- KILL NOASK,QUIT1
- +13 DO NOPARM^DVBAUTL2
- if $DATA(DVBAQUIT)
- GOTO KILL^DVBAUTIL
- +14 ;
- +15 SET HEAD="TOTAL ADMISSION REPORT"
- SET HEAD1="FOR "_$PIECE(DTAR,U,1)_" ON "_FDT(0)
- +16 IF $DATA(X)
- Begin DoDot:1
- +17 if X=""!(Y<0)
- GOTO KILL
- SET %ZIS="AEQ"
- DO ^%ZIS
- KILL %ZIS
- End DoDot:1
- +18 DO HFSOPEN^DVBAB82("DVBRP",DVBHFS,"W")
- IF DVBERR
- DO END^DVBAB82
- QUIT
- +19 IF POP
- KILL DVBAON2,DCHPTR,M,Y,J
- GOTO KILL^DVBAUTIL
- +20 USE IO
- +21 DO DEQUE
- +22 DO END^DVBAB82
- +23 QUIT
- SET if '$DATA(^DPT(DA,0))
- QUIT
- SET DFN=DA
- DO RCV^DVBAVDPT
- if CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
- QUIT
- +1 SET ^TMP($JOB,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
- +2 QUIT
- +3 ;
- PRINTB SET MA=$PIECE(DATA,U)
- SET RCVAA=$PIECE(DATA,U,2)
- SET RCVPEN=$PIECE(DATA,U,3)
- SET CNUM=$PIECE(DATA,U,4)
- SET DFN=DA
- SET QUIT1=1
- DO ADM^DVBAVDPT
- +1 if ADMDT]""
- SET ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
- +2 if DCHGDT]""
- SET DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
- +3 if ($GET(DVBADLMTR)'="")
- DO PRINTD
- +4 if ($GET(DVBADLMTR)="")
- DO PRINTND
- +5 QUIT
- +6 ;
- PRINTND ;print non-delimited admission inq report
- +1 if (IOST?1"C-".E!($DATA(DVBAON2)))
- WRITE @IOF
- +2 IF DVBGUI=0
- WRITE !!!,?(80-$LENGTH(HEAD)\2),HEAD,!,?(80-$LENGTH(HEAD1)\2),HEAD1,!!
- +3 IF DVBGUI=1
- WRITE !!
- +4 WRITE ?10,"Patient Name:",?26,PNAM,!!,?14,"Claim No:",?26,CNUM,!,?6,"Claim Folder Loc:",?26,CFLOC,!,?9,"Social Sec No:",?26,SSN,!,?8,"Admission Date:",?26,ADMDT,!,?3,"Admitting Diagnosis:",?26,DIAG,!
- +5 WRITE ?8,"Discharge Date:",?26,DCHGDT,!,?11,"Bed Service:",?26,BEDSEC,!,?13,"Recv A&A?:",?26,$SELECT(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),!
- +6 WRITE ?14,"Pension?:",?26,$SELECT(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),!
- DO ELIG^DVBAVDPT
- IF IOST'?1"C-".E
- SET DVBAON2=""
- +7 IF IOST?1"C-".E
- Begin DoDot:1
- +8 IF ($ORDER(^TMP($JOB,XCN))'=""!($ORDER(^TMP($JOB,XCN,CFLOC))'=""!($ORDER(^TMP($JOB,XCN,CFLOC,ADM))'=""!($ORDER(^TMP($JOB,XCN,CFLOC,ADM,DA))'=""))))
- Begin DoDot:2
- +9 IF DVBGUI=0
- Begin DoDot:3
- +10 WRITE *7,!,"Press RETURN to continue or ""^"" to stop "
- +11 READ ANS:DTIME
- +12 if ANS=U!('$TEST)
- SET QUIT=1
- +13 IF '$TEST
- SET DVBAQUIT=1
- End DoDot:3
- End DoDot:2
- +14 IF ($ORDER(^TMP($JOB,XCN))=""&($ORDER(^TMP($JOB,XCN,CFLOC))=""&($ORDER(^TMP($JOB,XCN,CFLOC,ADM))=""&($ORDER(^TMP($JOB,XCN,CFLOC,ADM,DA))=""))))
- Begin DoDot:2
- +15 IF DVBGUI=0
- Begin DoDot:3
- +16 WRITE *7,!,"Press RETURN to continue "
- +17 READ ANS:DTIME
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
- PRINTD ;print delimited admission inq report
- +1 ;eligibility logic copied from ELIG^DVBAVDPT
- +2 NEW ELIG,INCMP
- +3 SET ELIG=DVBAELIG
- SET INCMP=""
- +4 IF ELIG]""
- SET ELIG=ELIG_" ("_$SELECT(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
- +5 IF $DATA(^DPT(DA,.29))
- SET INCMP=$SELECT($PIECE(^(.29),U,12)=1:"Incompetent",1:"")
- +6 IF INCMP]""
- IF ELIG]""
- SET ELIG=ELIG_", "_INCMP
- +7 DO DEM^VADPT
- IF $GET(SSN)'=""
- SET SSN=$PIECE($GET(VADM(2)),U,2)
- +8 if ('DVBADHDR)
- DO COLHDR
- +9 WRITE !,""""_PNAM_""""_DVBADLMTR_$CHAR(160)_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR_""""_DIAG_""""_DVBADLMTR
- +10 WRITE DCHGDT_DVBADLMTR_""""_BEDSEC_""""_DVBADLMTR_$SELECT(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR
- +11 WRITE $SELECT(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR_""""_ELIG_""""
- +12 QUIT
- +13 ;
- PRINT USE IO
- SET QUIT=""
- KILL MA,MB
- +1 SET XCN=""
- FOR M=0:0
- SET XCN=$ORDER(^TMP($JOB,XCN))
- if XCN=""!(QUIT=1)
- QUIT
- SET CFLOC=""
- FOR J=0:0
- SET CFLOC=$ORDER(^TMP($JOB,XCN,CFLOC))
- if CFLOC=""!(QUIT=1)
- QUIT
- DO PRINT1
- +2 QUIT
- PRINT1 SET ADM=""
- FOR K=0:0
- SET ADM=$ORDER(^TMP($JOB,XCN,CFLOC,ADM))
- if ADM=""!(QUIT=1)
- QUIT
- SET DA=""
- FOR L=0:0
- SET DA=$ORDER(^TMP($JOB,XCN,CFLOC,ADM,DA))
- if DA=""!(QUIT=1)
- QUIT
- SET DATA=^(DA)
- DO PRINTB
- +1 QUIT
- +2 ;
- TERM DO HOME^%ZIS
- KILL NOASK,QUIT1
- +1 DO NOPARM^DVBAUTL2
- if $DATA(DVBAQUIT)
- GOTO KILL^DVBAUTIL
- +2 ;
- SETUP WRITE @IOF,!,"VARO COMPLETE ADMISSION REPORT"
- SET DTAR=^DVB(396.1,1,0)
- SET FDT(0)=$$FMTE^XLFDT(DT,"5DZ")
- +1 SET HEAD="TOTAL ADMISSION REPORT"
- SET HEAD1="FOR "_$PIECE(DTAR,U,1)_" ON "_FDT(0)
- +2 WRITE !,HEAD1
- EN1 WRITE !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on "
- SET Y=$PIECE(DTAR,U,3)
- XECUTE ^DD("DD")
- WRITE Y,!!
- +1 DO DATE^DVBAUTIL
- +2 if X=""!(Y<0)
- GOTO KILL
- SET %ZIS="AEQ"
- DO ^%ZIS
- KILL %ZIS
- +3 IF POP
- KILL DVBAON2,DCHPTR,M,Y,J
- GOTO KILL^DVBAUTIL
- +4 ;
- QUEUE IF $DATA(IO("Q"))
- SET ZTRTN="DEQUE^DVBAADRP"
- SET ZTIO=ION
- SET NOASK=1
- SET ZTDESC="AMIE ADMISSION REPORT"
- FOR I="BDATE","EDATE","HEAD","HEAD1","RO","RONUM","FDT(0)","NOASK"
- SET ZTSAVE(I)=""
- +1 IF $DATA(IO("Q"))
- DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !!,"Request queued.",!!
- GOTO KILL
- +2 ;
- GO SET MA=BDATE
- FOR J=0:0
- SET MA=$ORDER(^DGPM("AMV1",MA))
- if $PIECE(MA,".")>EDATE!(MA="")
- QUIT
- if (('$DATA(NOASK))&($GET(DVBADLMTR)=""))
- WRITE "."
- FOR DA=0:0
- SET DA=$ORDER(^DGPM("AMV1",MA,DA))
- if DA=""
- QUIT
- FOR MB=0:0
- SET MB=$ORDER(^DGPM("AMV1",MA,DA,MB))
- if MB=""
- QUIT
- IF MA'>EDATE
- DO SET
- +1 IF '$DATA(^TMP($JOB))
- Begin DoDot:1
- +2 USE IO
- +3 if ($GET(DVBADLMTR)="")
- WRITE !!,*7
- +4 WRITE "No data found for parameters entered.",!!
- End DoDot:1
- HANG 2
- GOTO KILL
- +5 if (($GET(DVBGUI)=1)&($GET(DVBADLMTR)=""))
- WRITE !,HEAD,!,HEAD1,!
- +6 IF $DATA(^TMP($JOB))
- DO PRINT
- IF $DATA(DVBAQUIT)
- KILL DVBAON2,DCHPTR,M,Y,J
- GOTO KILL^DVBAUTIL
- +7 ;
- KILL ;
- +1 DO ^%ZISC
- SET X=3
- KILL DVBAON2,DCHPTR,M,Y,J
- if $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- GOTO FINAL^DVBAUTIL
- +2 ;
- DEQUE KILL ^TMP($JOB)
- GOTO GO
- +1 ;
- COLHDR ;Column header for delimited report
- +1 WRITE "Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
- +2 WRITE "Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR_"Admitting Diagnosis"_DVBADLMTR
- +3 WRITE "Discharge Date"_DVBADLMTR_"Bed Service"_DVBADLMTR_"Recv A&A?"_DVBADLMTR
- +4 WRITE "Pension?"_DVBADLMTR_"Eligibility Data"
- +5 ;set so header info only printed once
- SET DVBADHDR=1
- +6 QUIT