- DVBAB98 ;ALB/SPH - CAPRI CONVERSION OF DVBARAD1 FOR SUPPORT ; 3/22/12 8:33am
- ;;2.7;AMIE;**35,149,179,185**;Apr 10, 1995;Build 18
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- S ZX="PENSION ",ZY="A & A "
- S MSG="" F ZZ=1:1:7 S MSG=MSG_ZX
- S MSG1="" F ZZ=1:1:7 S MSG1=MSG1_ZY
- U IO K DVBAQUIT
- F DVBAT="PEN","A&A" W:((IOST?1"C-".E)!(IOST'?1"P-OTHER".E)) @IOF W !!!!!!!!!! D PRINT Q:$D(DVBAQUIT)
- S ZMSG=$NA(^TMP("DVBAR",$J))
- G KILL
- ;
- PRINTB S DATA1=$S($D(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC,K,DA,"LADM")):^("LADM"),1:"") S (LADMDT,ADMDT)=$P(DATA1,U),LTDIS=$P(DATA1,U,2),DFN=DA,QUIT1=1 K DATA1 D ADM^DVBAVDPT K QUIT1,DVBAQ
- S LBEDSEC=BEDSEC,LDIAG=DIAG,LDCHGDT=DCHGDT,ADMDT=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5) D ADM^DVBAVDPT
- S RCVPEN=$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),RCVAA=$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
- W @IOF,!!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!,?(80-$L(HEADDT)\2),HEADDT,!!!
- S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
- S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
- S:LADMDT]"" LADMDT=$$FMTE^XLFDT(LADMDT,"5DZ")
- S:LDCHGDT]"" LDCHGDT=$$FMTE^XLFDT(LDCHGDT,"5DZ")
- ;create delimited/non-delimited report
- D:($G(DVBADLMTR)'="") PRINTD
- D:($G(DVBADLMTR)="") PRINTND
- Q
- ;
- PRINTND ;create non-delimited re-admission report
- S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Patient: "_PNAM_" SSN: "_SSN_" Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Claim #: "_CNUM_" Pension: "_RCVPEN_" A&A: "_RCVAA,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1
- D ELIG
- S ^TMP("DVBAR",$J,DVBABCNT)="Current Admission Data:",DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="-----------------------",DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Admission Date: "_ADMDT,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Date: "_DCHGDT,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Type: "_TDIS,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Prior Admission Data:",DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="---------------------",DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Admission Date: "_LADMDT,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Admitting Diagnosis: "_LDIAG,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Date: "_LDCHGDT,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Type: "_LTDIS,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="Bed Service: "_LBEDSEC,DVBABCNT=DVBABCNT+1
- S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1
- ;I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) XCN="ZZZZ" I '$T S DVBAQUIT=1
- Q
- ;
- PRINTD ;create delimited re-admission report
- N DVBATMP,X,X1,X2,X3
- D:('$D(^XTMP("DVBA_READMISSION_RPT"_$J,0))) COLHDR
- S ^TMP("DVBAR",$J,DVBABCNT)=PNAM_DVBADLMTR_SSN_DVBADLMTR_CFLOC_DVBADLMTR_CNUM_DVBADLMTR_RCVPEN_DVBADLMTR_RCVAA_DVBADLMTR
- D ELIG
- S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ADMDT_DVBADLMTR_DIAG_DVBADLMTR_DCHGDT_DVBADLMTR_TDIS_DVBADLMTR_BEDSEC_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_LADMDT_DVBADLMTR_LDIAG_DVBADLMTR_LDCHGDT_DVBADLMTR_LTDIS_DVBADLMTR_LBEDSEC
- ;
- S DVBATMP=^TMP("DVBAR",$J,DVBABCNT)
- S X=$P(DVBATMP,DVBADLMTR,2)
- I $L(X)'>9 S X=""""_$E("000000000",1,9-$L(X))_X_"""",X1=$E(X,1,4),X2=$E(X,5,6),X3=$E(X,7,11),X=X1_"-"_X2_"-"_X3
- I $E(X,10,10)'?.N S X=""""_$E("0000000000",1,10-$L(X))_X_"""",X1=$E(X,1,4),X2=$E(X,5,6),X3=$E(X,7,12),X=X1_"-"_X2_"-"_X3
- S $P(DVBATMP,DVBADLMTR,2)=X
- S X=$P(DVBATMP,DVBADLMTR,4)
- S X=$C(160)_X
- S $P(DVBATMP,DVBADLMTR,4)=X
- F I=1:1:$L(DVBATMP,DVBADLMTR) I $P(DVBATMP,DVBADLMTR,I)["," S $P(DVBATMP,DVBADLMTR,I)=""""_$P(DVBATMP,DVBADLMTR,I)_""""
- S DVBATMP=$TR(DVBATMP,DVBADLMTR,",")
- S ^TMP("DVBAR",$J,DVBABCNT)=DVBATMP
- ;
- S DVBABCNT=DVBABCNT+1
- Q
- ;
- PRINT S NODTA=1 S (SORTDT,XCN,XCFLOC,ANS)=""
- I $D(^TMP("DVBA",DVBAT,$J)) F XLINE=1:1:5 W ?5,$S(DVBAT="PEN":MSG,DVBAT="A&A":MSG1,1:""),!!
- F G=0:0 S SORTDT=$O(^TMP("DVBA",DVBAT,$J,SORTDT)) Q:SORTDT="" F DVBAM=0:0 S XCN=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN)) Q:XCN="" D PRINT1
- Q
- PRINT1 F J=0:0 S XCFLOC=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC)) Q:XCFLOC="" F K=0:0 S K=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC,K)) Q:K="" D PRINTC
- Q
- PRINTC F DA=0:0 S DA=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC,K,DA)) Q:DA="" S DATA=^(DA) D PRINTB
- Q
- ;
- KILL K ^TMP("DVBA","A&A",$J),^TMP("DVBA","PEN",$J)
- K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_READMISSION_RPT"_$J,0)
- D ^%ZISC S X=7 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
- ;
- ELIG S ELIG=DVBAELIG,INCMP=0
- W "Eligibility: "
- 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)),$P(^(.29),U,1)]"" S INCMP=1 ;date ruled incomp, VA
- I $D(^DPT(DA,.29)),$P(^(.29),U,12)=1 S INCMP=1 ;ruled incomp field
- W ELIG_$S(ELIG]"":", ",1:"") W:$X>60 !?14 W $S(INCMP=1:"Incompetent",1:""),!
- Q
- ;
- COLHDR ;Column header for delimited report
- N DVBADLMTR
- S DVBADLMTR=","
- S ^TMP("DVBAR",$J,DVBABCNT)="Patient"_DVBADLMTR_"SSN"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Claim #"_DVBADLMTR_"Pension"_DVBADLMTR_"A&A"_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Current Admission Date"_DVBADLMTR_"Current Admitting Diagnosis"_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Current Discharge Date"_DVBADLMTR_"Current Discharge Type"_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Current Bed Service"_DVBADLMTR_"Prior Admission Date"_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Prior Admitting Diagnosis"_DVBADLMTR_"Prior Discharge Date"_DVBADLMTR
- S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Prior Discharge Type"_DVBADLMTR_"Prior Bed Service"
- S DVBABCNT=DVBABCNT+1
- S ^XTMP("DVBA_READMISSION_RPT"_$J,0)=DT_U_DT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB98 6445 printed Mar 13, 2025@20:45:25 Page 2
- DVBAB98 ;ALB/SPH - CAPRI CONVERSION OF DVBARAD1 FOR SUPPORT ; 3/22/12 8:33am
- +1 ;;2.7;AMIE;**35,149,179,185**;Apr 10, 1995;Build 18
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 SET ZX="PENSION "
- SET ZY="A & A "
- +5 SET MSG=""
- FOR ZZ=1:1:7
- SET MSG=MSG_ZX
- +6 SET MSG1=""
- FOR ZZ=1:1:7
- SET MSG1=MSG1_ZY
- +7 USE IO
- KILL DVBAQUIT
- +8 FOR DVBAT="PEN","A&A"
- if ((IOST?1"C-".E)!(IOST'?1"P-OTHER".E))
- WRITE @IOF
- WRITE !!!!!!!!!!
- DO PRINT
- if $DATA(DVBAQUIT)
- QUIT
- +9 SET ZMSG=$NAME(^TMP("DVBAR",$JOB))
- +10 GOTO KILL
- +11 ;
- PRINTB SET DATA1=$SELECT($DATA(^TMP("DVBA",DVBAT,$JOB,SORTDT,XCN,XCFLOC,K,DA,"LADM")):^("LADM"),1:"")
- SET (LADMDT,ADMDT)=$PIECE(DATA1,U)
- SET LTDIS=$PIECE(DATA1,U,2)
- SET DFN=DA
- SET QUIT1=1
- KILL DATA1
- DO ADM^DVBAVDPT
- KILL QUIT1,DVBAQ
- +1 SET LBEDSEC=BEDSEC
- SET LDIAG=DIAG
- SET LDCHGDT=DCHGDT
- SET ADMDT=$PIECE(DATA,U)
- SET RCVAA=$PIECE(DATA,U,2)
- SET RCVPEN=$PIECE(DATA,U,3)
- SET CNUM=$PIECE(DATA,U,4)
- SET TDIS=$PIECE(DATA,U,5)
- DO ADM^DVBAVDPT
- +2 SET RCVPEN=$SELECT(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")
- SET RCVAA=$SELECT(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
- +3 WRITE @IOF,!!!,?(80-$LENGTH(HEAD)\2),HEAD,!,?(80-$LENGTH(HEAD1)\2),HEAD1,!,?(80-$LENGTH(HEADDT)\2),HEADDT,!!!
- +4 if ADMDT]""
- SET ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
- +5 if DCHGDT]""
- SET DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
- +6 if LADMDT]""
- SET LADMDT=$$FMTE^XLFDT(LADMDT,"5DZ")
- +7 if LDCHGDT]""
- SET LDCHGDT=$$FMTE^XLFDT(LDCHGDT,"5DZ")
- +8 ;create delimited/non-delimited report
- +9 if ($GET(DVBADLMTR)'="")
- DO PRINTD
- +10 if ($GET(DVBADLMTR)="")
- DO PRINTND
- +11 QUIT
- +12 ;
- PRINTND ;create non-delimited re-admission report
- +1 SET ^TMP("DVBAR",$JOB,DVBABCNT)=""
- SET DVBABCNT=DVBABCNT+1
- +2 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Patient: "_PNAM_" SSN: "_SSN_" Claim Folder Loc: "_CFLOC
- SET DVBABCNT=DVBABCNT+1
- +3 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Claim #: "_CNUM_" Pension: "_RCVPEN_" A&A: "_RCVAA
- SET DVBABCNT=DVBABCNT+1
- +4 SET ^TMP("DVBAR",$JOB,DVBABCNT)="================================================================================"
- SET DVBABCNT=DVBABCNT+1
- +5 DO ELIG
- +6 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Current Admission Data:"
- SET DVBABCNT=DVBABCNT+1
- +7 SET ^TMP("DVBAR",$JOB,DVBABCNT)="-----------------------"
- SET DVBABCNT=DVBABCNT+1
- +8 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Admission Date: "_ADMDT
- SET DVBABCNT=DVBABCNT+1
- +9 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Admitting Diagnosis: "_DIAG
- SET DVBABCNT=DVBABCNT+1
- +10 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Discharge Date: "_DCHGDT
- SET DVBABCNT=DVBABCNT+1
- +11 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Discharge Type: "_TDIS
- SET DVBABCNT=DVBABCNT+1
- +12 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Bed Service: "_BEDSEC
- SET DVBABCNT=DVBABCNT+1
- +13 SET ^TMP("DVBAR",$JOB,DVBABCNT)=""
- SET DVBABCNT=DVBABCNT+1
- +14 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Prior Admission Data:"
- SET DVBABCNT=DVBABCNT+1
- +15 SET ^TMP("DVBAR",$JOB,DVBABCNT)="---------------------"
- SET DVBABCNT=DVBABCNT+1
- +16 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Admission Date: "_LADMDT
- SET DVBABCNT=DVBABCNT+1
- +17 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Admitting Diagnosis: "_LDIAG
- SET DVBABCNT=DVBABCNT+1
- +18 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Discharge Date: "_LDCHGDT
- SET DVBABCNT=DVBABCNT+1
- +19 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Discharge Type: "_LTDIS
- SET DVBABCNT=DVBABCNT+1
- +20 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Bed Service: "_LBEDSEC
- SET DVBABCNT=DVBABCNT+1
- +21 SET ^TMP("DVBAR",$JOB,DVBABCNT)=""
- SET DVBABCNT=DVBABCNT+1
- +22 ;I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) XCN="ZZZZ" I '$T S DVBAQUIT=1
- +23 QUIT
- +24 ;
- PRINTD ;create delimited re-admission report
- +1 NEW DVBATMP,X,X1,X2,X3
- +2 if ('$DATA(^XTMP("DVBA_READMISSION_RPT"_$JOB,0)))
- DO COLHDR
- +3 SET ^TMP("DVBAR",$JOB,DVBABCNT)=PNAM_DVBADLMTR_SSN_DVBADLMTR_CFLOC_DVBADLMTR_CNUM_DVBADLMTR_RCVPEN_DVBADLMTR_RCVAA_DVBADLMTR
- +4 DO ELIG
- +5 SET ^TMP("DVBAR",$JOB,DVBABCNT)=^TMP("DVBAR",$JOB,DVBABCNT)_ADMDT_DVBADLMTR_DIAG_DVBADLMTR_DCHGDT_DVBADLMTR_TDIS_DVBADLMTR_BEDSEC_DVBADLMTR
- +6 SET ^TMP("DVBAR",$JOB,DVBABCNT)=^TMP("DVBAR",$JOB,DVBABCNT)_LADMDT_DVBADLMTR_LDIAG_DVBADLMTR_LDCHGDT_DVBADLMTR_LTDIS_DVBADLMTR_LBEDSEC
- +7 ;
- +8 SET DVBATMP=^TMP("DVBAR",$JOB,DVBABCNT)
- +9 SET X=$PIECE(DVBATMP,DVBADLMTR,2)
- +10 IF $LENGTH(X)'>9
- SET X=""""_$EXTRACT("000000000",1,9-$LENGTH(X))_X_""""
- SET X1=$EXTRACT(X,1,4)
- SET X2=$EXTRACT(X,5,6)
- SET X3=$EXTRACT(X,7,11)
- SET X=X1_"-"_X2_"-"_X3
- +11 IF $EXTRACT(X,10,10)'?.N
- SET X=""""_$EXTRACT("0000000000",1,10-$LENGTH(X))_X_""""
- SET X1=$EXTRACT(X,1,4)
- SET X2=$EXTRACT(X,5,6)
- SET X3=$EXTRACT(X,7,12)
- SET X=X1_"-"_X2_"-"_X3
- +12 SET $PIECE(DVBATMP,DVBADLMTR,2)=X
- +13 SET X=$PIECE(DVBATMP,DVBADLMTR,4)
- +14 SET X=$CHAR(160)_X
- +15 SET $PIECE(DVBATMP,DVBADLMTR,4)=X
- +16 FOR I=1:1:$LENGTH(DVBATMP,DVBADLMTR)
- IF $PIECE(DVBATMP,DVBADLMTR,I)[","
- SET $PIECE(DVBATMP,DVBADLMTR,I)=""""_$PIECE(DVBATMP,DVBADLMTR,I)_""""
- +17 SET DVBATMP=$TRANSLATE(DVBATMP,DVBADLMTR,",")
- +18 SET ^TMP("DVBAR",$JOB,DVBABCNT)=DVBATMP
- +19 ;
- +20 SET DVBABCNT=DVBABCNT+1
- +21 QUIT
- +22 ;
- PRINT SET NODTA=1
- SET (SORTDT,XCN,XCFLOC,ANS)=""
- +1 IF $DATA(^TMP("DVBA",DVBAT,$JOB))
- FOR XLINE=1:1:5
- WRITE ?5,$SELECT(DVBAT="PEN":MSG,DVBAT="A&A":MSG1,1:""),!!
- +2 FOR G=0:0
- SET SORTDT=$ORDER(^TMP("DVBA",DVBAT,$JOB,SORTDT))
- if SORTDT=""
- QUIT
- FOR DVBAM=0:0
- SET XCN=$ORDER(^TMP("DVBA",DVBAT,$JOB,SORTDT,XCN))
- if XCN=""
- QUIT
- DO PRINT1
- +3 QUIT
- PRINT1 FOR J=0:0
- SET XCFLOC=$ORDER(^TMP("DVBA",DVBAT,$JOB,SORTDT,XCN,XCFLOC))
- if XCFLOC=""
- QUIT
- FOR K=0:0
- SET K=$ORDER(^TMP("DVBA",DVBAT,$JOB,SORTDT,XCN,XCFLOC,K))
- if K=""
- QUIT
- DO PRINTC
- +1 QUIT
- PRINTC FOR DA=0:0
- SET DA=$ORDER(^TMP("DVBA",DVBAT,$JOB,SORTDT,XCN,XCFLOC,K,DA))
- if DA=""
- QUIT
- SET DATA=^(DA)
- DO PRINTB
- +1 QUIT
- +2 ;
- KILL KILL ^TMP("DVBA","A&A",$JOB),^TMP("DVBA","PEN",$JOB)
- +1 if (DVBAFNLDTE=$PIECE(EDATE,"."))
- KILL ^XTMP("DVBA_READMISSION_RPT"_$JOB,0)
- +2 DO ^%ZISC
- SET X=7
- if $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- GOTO FINAL^DVBAUTIL
- +3 ;
- ELIG SET ELIG=DVBAELIG
- SET INCMP=0
- +1 WRITE "Eligibility: "
- +2 IF ELIG]""
- SET ELIG=ELIG_" ("_$SELECT(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
- +3 ;date ruled incomp, VA
- IF $DATA(^DPT(DA,.29))
- IF $PIECE(^(.29),U,1)]""
- SET INCMP=1
- +4 ;ruled incomp field
- IF $DATA(^DPT(DA,.29))
- IF $PIECE(^(.29),U,12)=1
- SET INCMP=1
- +5 WRITE ELIG_$SELECT(ELIG]"":", ",1:"")
- if $X>60
- WRITE !?14
- WRITE $SELECT(INCMP=1:"Incompetent",1:""),!
- +6 QUIT
- +7 ;
- COLHDR ;Column header for delimited report
- +1 NEW DVBADLMTR
- +2 SET DVBADLMTR=","
- +3 SET ^TMP("DVBAR",$JOB,DVBABCNT)="Patient"_DVBADLMTR_"SSN"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR
- +4 SET ^TMP("DVBAR",$JOB,DVBABCNT)=(^TMP("DVBAR",$JOB,DVBABCNT))_"Claim #"_DVBADLMTR_"Pension"_DVBADLMTR_"A&A"_DVBADLMTR
- +5 SET ^TMP("DVBAR",$JOB,DVBABCNT)=(^TMP("DVBAR",$JOB,DVBABCNT))_"Current Admission Date"_DVBADLMTR_"Current Admitting Diagnosis"_DVBADLMTR
- +6 SET ^TMP("DVBAR",$JOB,DVBABCNT)=(^TMP("DVBAR",$JOB,DVBABCNT))_"Current Discharge Date"_DVBADLMTR_"Current Discharge Type"_DVBADLMTR
- +7 SET ^TMP("DVBAR",$JOB,DVBABCNT)=(^TMP("DVBAR",$JOB,DVBABCNT))_"Current Bed Service"_DVBADLMTR_"Prior Admission Date"_DVBADLMTR
- +8 SET ^TMP("DVBAR",$JOB,DVBABCNT)=(^TMP("DVBAR",$JOB,DVBABCNT))_"Prior Admitting Diagnosis"_DVBADLMTR_"Prior Discharge Date"_DVBADLMTR
- +9 SET ^TMP("DVBAR",$JOB,DVBABCNT)=(^TMP("DVBAR",$JOB,DVBABCNT))_"Prior Discharge Type"_DVBADLMTR_"Prior Bed Service"
- +10 SET DVBABCNT=DVBABCNT+1
- +11 SET ^XTMP("DVBA_READMISSION_RPT"_$JOB,0)=DT_U_DT
- +12 QUIT
