- DGBTOA2 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS (Cont) ;9/25/12 5:19pm
- ;;1.0;Beneficiary Travel;**2,7,21,28**;September 25, 2001;Build 12
- ;sort by ACCT, CARrier or PATient=DGBTBY
- ;associated cross-ref =DGBTIX
- START D NOW^%DTC S Y=$E(%,1,12) S VADAT("W")=Y D ^VADATE S U="^",DGBTDT=VADATE("E"),$P(DGBTCL,"=",81)="",(DGBTU,DGBTA,DGBTV,DGBT2,DGBTDV,DGBTCH,DGBTS,DGBTSD,X2,DGBTD,DGBTU,DGBTY,DGBT4,DGBTDN,DGBTI,DGBTOTX)=0 D PID^VADPT
- S DGBTIX=$S(DGBTSL="ACCT":"AC",DGBTSL="CAR":"AS",DGBTSL="TYP":"ACTP",1:"C")
- I $P($G(^DG(43,1,"BT")),U,4) S DGBTIX=$S(DGBTSL="CAR":"AFLS",1:DGBTIX)
- D SORT G:DGBTU QUIT1 I $D(^UTILITY($J)) D TOTAL^DGBTOA4 G QUIT1
- W !,"=====>NO PATIENTS FOUND"
- QUIT1 D CLOSE^DGBTUTQ Q
- ;Loops thru the "AC","AS","ACTP" or "C" X-ref, depending upon selected sort list
- SORT F DGBTBY=0:0 S DGBTBY=$O(^DGBT(392,DGBTIX,DGBTBY)) Q:DGBTBY=""!(DGBTU) I $D(VAUTN(DGBTBY))!(VAUTN) D DATE
- D PR^DGBTOA3 Q
- DATE F DGBTD=DGBTBEG:0 S DGBTD=$O(^DGBT(392,DGBTIX,DGBTBY,DGBTD)) Q:DGBTD=""!(DGBTU)!(DGBTD>DGBTEND) I $D(^DGBT(392,DGBTIX,DGBTBY,DGBTD)) D SET
- Q
- SET ;Sets up variables and does validity checks, also sets up Utility
- ;for individual totals
- Q:'$D(^DGBT(392,DGBTD,0))
- S DGBTK=^DGBT(392,DGBTD,0) Q:'$D(^DPT(+$P(DGBTK,U,2),0)) S DGBTO=^(0),DGBTDN=$S($P(DGBTK,U,11):$P(DGBTK,U,11),1:""),DGBTDV=$S('DGBTDN:"ZNOT SPECIFIED",1:$P(^DG(40.8,DGBTDN,0),U,1))
- Q:('VAUTD)&'$D(VAUTD(+DGBTDN))
- Q:'DGBTDN ;dbe patch DGBT*1*21
- I '$P($G(^DG(43,1,"BT")),U,4) S DGBTB=$S($P(DGBTK,U,7):$P(^PRC(440,$P(DGBTK,U,7),0),U,1),1:"")
- I $P($G(^DG(43,1,"BT")),U,4) S DGBTB=$S($P(DGBTK,U,14):$P(^DGBT(392.31,$P(DGBTK,U,14),0),U,1),1:"")
- S DGBTK9=$P(DGBTK,U,9),DGBTK10=$S($P(DGBTK,U,15)="S":$P($G(^DGBT(392,DGBTD,"SP")),U,4),1:$P(DGBTK,U,10)) ;*28 modified code to add special mode claims to the total
- S DGBTCW=$S('+$P(DGBTK,U,6):"UNKNOWN",1:$P(^DGBT(392.3,+$P(DGBTK,U,6),0),U,1)),DGBTCH=$S(+DGBTCW:+DGBTCW,1:""),DGBTC=$S(+DGBTCW:$E($P(DGBTCW," ",2,$L(DGBTCW," ")),1,15),1:"")
- S (DGBTG,DGBTXX)=0,DGBTI=$S(DGBTSL="PAT":$P(DGBTO,U,1),DGBTSL="CAR":DGBTB,1:DGBTC)
- S DGBTP=$P(DGBTO,U,1),DFN=$P(DGBTK,U,2) D PID^VADPT6 S SSN=$S(VA("PID")]"":VA("PID"),1:"UNKNOWN") D PATU:DGBTSL="PAT",ACCTU:DGBTSL'="PAT"
- S DGBTS=$S($P(DGBTK,U,2):$P(DGBTK,U,2),1:""),DGBTSD=$S($P(DGBTK,U,6):$P(DGBTK,U,6),1:"")
- I $D(^UTILITY($J,2,DGBTDN,DGBTP,SSN,"T")) S DGBTS=$S($P(^UTILITY($J,2,DGBTDN,DGBTP,SSN,"T"),U,1):$P(^("T"),U,1),1:"")+DGBTS,DGBTSD=$S($P(^UTILITY($J,2,DGBTDN,DGBTP,SSN,"T"),U,2):$P(^("T"),U,2),1:"")+DGBTSD
- I $D(^UTILITY($J,2,DGBTDN,DGBTCW,"T")) S DGBTS=$S($P(^UTILITY($J,2,DGBTDN,DGBTCW,"T"),U,1):$P(^("T"),U,1),1:"")+DGBTS,DGBTSD=$S($P(^UTILITY($J,2,DGBTDN,DGBTCW,"T"),U,2):$P(^("T"),U,2),1:"")+DGBTSD
- I DGBTSL="PAT" S ^UTILITY($J,2,DGBTDN,DGBTP,SSN,"T")=DGBTS_U_DGBTSD_U_SSN Q
- S ^UTILITY($J,2,DGBTDN,DGBTCW,"T")=DGBTS_U_DGBTSD_U_DGBTBY Q
- ;Sets up Utility for valid patients
- PATU S ^UTILITY($J,1,DGBTDN,DGBTP,SSN,DGBTD)=DGBTP_U_DGBTK10_U_DGBTCH_U_DGBTC_U_DGBTB_U_DGBTK9,DGBTK=^(DGBTD) Q
- ;Sets up Utility for valid accounts, account types and carriers
- ACCTU S DGBTCW=$S(DGBTSL="CAR"&('$P($G(^DG(43,1,"BT")),U,4)):$P(^PRC(440,DGBTBY,0),U,1),DGBTSL="CAR"&($P($G(^DG(43,1,"BT")),U,4)):$P(^DGBT(392.31,DGBTBY,0),U,1),1:DGBTCW)
- S DGBTOTX(DGBTDN,DGBTCW)=$S('$D(DGBTOTX(DGBTDN,DGBTCW)):0,1:DGBTOTX(DGBTDN,DGBTCW)),DGBTOTX(DGBTDN,DGBTCW)=DGBTOTX(DGBTDN,DGBTCW)+1
- S DGBTPTC(DGBTDV)=$S('$D(DGBTPTC(DGBTDV)):0,1:DGBTPTC(DGBTDV)) S DGBTPTC(DGBTDV)=DGBTPTC(DGBTDV)+1
- S ^UTILITY($J,1,DGBTDN,DGBTCW,DGBTP,SSN,DGBTD)=DGBTP_U_DGBTK10_U_DGBTCH_U_DGBTC_U_DGBTB_U_DGBTK9,DGBTK=^(DGBTD) Q
- CM N X3 D COMMA^%DTC Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTOA2 3626 printed Feb 18, 2025@23:07:13 Page 2
- DGBTOA2 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS (Cont) ;9/25/12 5:19pm
- +1 ;;1.0;Beneficiary Travel;**2,7,21,28**;September 25, 2001;Build 12
- +2 ;sort by ACCT, CARrier or PATient=DGBTBY
- +3 ;associated cross-ref =DGBTIX
- START DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- SET VADAT("W")=Y
- DO ^VADATE
- SET U="^"
- SET DGBTDT=VADATE("E")
- SET $PIECE(DGBTCL,"=",81)=""
- SET (DGBTU,DGBTA,DGBTV,DGBT2,DGBTDV,DGBTCH,DGBTS,DGBTSD,X2,DGBTD,DGBTU,DGBTY,DGBT4,DGBTDN,DGBTI,DGBTOTX)=0
- DO PID^VADPT
- +1 SET DGBTIX=$SELECT(DGBTSL="ACCT":"AC",DGBTSL="CAR":"AS",DGBTSL="TYP":"ACTP",1:"C")
- +2 IF $PIECE($GET(^DG(43,1,"BT")),U,4)
- SET DGBTIX=$SELECT(DGBTSL="CAR":"AFLS",1:DGBTIX)
- +3 DO SORT
- if DGBTU
- GOTO QUIT1
- IF $DATA(^UTILITY($JOB))
- DO TOTAL^DGBTOA4
- GOTO QUIT1
- +4 WRITE !,"=====>NO PATIENTS FOUND"
- QUIT1 DO CLOSE^DGBTUTQ
- QUIT
- +1 ;Loops thru the "AC","AS","ACTP" or "C" X-ref, depending upon selected sort list
- SORT FOR DGBTBY=0:0
- SET DGBTBY=$ORDER(^DGBT(392,DGBTIX,DGBTBY))
- if DGBTBY=""!(DGBTU)
- QUIT
- IF $DATA(VAUTN(DGBTBY))!(VAUTN)
- DO DATE
- +1 DO PR^DGBTOA3
- QUIT
- DATE FOR DGBTD=DGBTBEG:0
- SET DGBTD=$ORDER(^DGBT(392,DGBTIX,DGBTBY,DGBTD))
- if DGBTD=""!(DGBTU)!(DGBTD>DGBTEND)
- QUIT
- IF $DATA(^DGBT(392,DGBTIX,DGBTBY,DGBTD))
- DO SET
- +1 QUIT
- SET ;Sets up variables and does validity checks, also sets up Utility
- +1 ;for individual totals
- +2 if '$DATA(^DGBT(392,DGBTD,0))
- QUIT
- +3 SET DGBTK=^DGBT(392,DGBTD,0)
- if '$DATA(^DPT(+$PIECE(DGBTK,U,2),0))
- QUIT
- SET DGBTO=^(0)
- SET DGBTDN=$SELECT($PIECE(DGBTK,U,11):$PIECE(DGBTK,U,11),1:"")
- SET DGBTDV=$SELECT('DGBTDN:"ZNOT SPECIFIED",1:$PIECE(^DG(40.8,DGBTDN,0),U,1))
- +4 if ('VAUTD)&'$DATA(VAUTD(+DGBTDN))
- QUIT
- +5 ;dbe patch DGBT*1*21
- if 'DGBTDN
- QUIT
- +6 IF '$PIECE($GET(^DG(43,1,"BT")),U,4)
- SET DGBTB=$SELECT($PIECE(DGBTK,U,7):$PIECE(^PRC(440,$PIECE(DGBTK,U,7),0),U,1),1:"")
- +7 IF $PIECE($GET(^DG(43,1,"BT")),U,4)
- SET DGBTB=$SELECT($PIECE(DGBTK,U,14):$PIECE(^DGBT(392.31,$PIECE(DGBTK,U,14),0),U,1),1:"")
- +8 ;*28 modified code to add special mode claims to the total
- SET DGBTK9=$PIECE(DGBTK,U,9)
- SET DGBTK10=$SELECT($PIECE(DGBTK,U,15)="S":$PIECE($GET(^DGBT(392,DGBTD,"SP")),U,4),1:$PIECE(DGBTK,U,10))
- +9 SET DGBTCW=$SELECT('+$PIECE(DGBTK,U,6):"UNKNOWN",1:$PIECE(^DGBT(392.3,+$PIECE(DGBTK,U,6),0),U,1))
- SET DGBTCH=$SELECT(+DGBTCW:+DGBTCW,1:"")
- SET DGBTC=$SELECT(+DGBTCW:$EXTRACT($PIECE(DGBTCW," ",2,$LENGTH(DGBTCW," ")),1,15),1:"")
- +10 SET (DGBTG,DGBTXX)=0
- SET DGBTI=$SELECT(DGBTSL="PAT":$PIECE(DGBTO,U,1),DGBTSL="CAR":DGBTB,1:DGBTC)
- +11 SET DGBTP=$PIECE(DGBTO,U,1)
- SET DFN=$PIECE(DGBTK,U,2)
- DO PID^VADPT6
- SET SSN=$SELECT(VA("PID")]"":VA("PID"),1:"UNKNOWN")
- if DGBTSL="PAT"
- DO PATU
- if DGBTSL'="PAT"
- DO ACCTU
- +12 SET DGBTS=$SELECT($PIECE(DGBTK,U,2):$PIECE(DGBTK,U,2),1:"")
- SET DGBTSD=$SELECT($PIECE(DGBTK,U,6):$PIECE(DGBTK,U,6),1:"")
- +13 IF $DATA(^UTILITY($JOB,2,DGBTDN,DGBTP,SSN,"T"))
- SET DGBTS=$SELECT($PIECE(^UTILITY($JOB,2,DGBTDN,DGBTP,SSN,"T"),U,1):$PIECE(^("T"),U,1),1:"")+DGBTS
- SET DGBTSD=$SELECT($PIECE(^UTILITY($JOB,2,DGBTDN,DGBTP,SSN,"T"),U,2):$PIECE(^("T"),U,2),1:"")+DGBTSD
- +14 IF $DATA(^UTILITY($JOB,2,DGBTDN,DGBTCW,"T"))
- SET DGBTS=$SELECT($PIECE(^UTILITY($JOB,2,DGBTDN,DGBTCW,"T"),U,1):$PIECE(^("T"),U,1),1:"")+DGBTS
- SET DGBTSD=$SELECT($PIECE(^UTILITY($JOB,2,DGBTDN,DGBTCW,"T"),U,2):$PIECE(^("T"),U,2),1:"")+DGBTSD
- +15 IF DGBTSL="PAT"
- SET ^UTILITY($JOB,2,DGBTDN,DGBTP,SSN,"T")=DGBTS_U_DGBTSD_U_SSN
- QUIT
- +16 SET ^UTILITY($JOB,2,DGBTDN,DGBTCW,"T")=DGBTS_U_DGBTSD_U_DGBTBY
- QUIT
- +17 ;Sets up Utility for valid patients
- PATU SET ^UTILITY($JOB,1,DGBTDN,DGBTP,SSN,DGBTD)=DGBTP_U_DGBTK10_U_DGBTCH_U_DGBTC_U_DGBTB_U_DGBTK9
- SET DGBTK=^(DGBTD)
- QUIT
- +1 ;Sets up Utility for valid accounts, account types and carriers
- ACCTU SET DGBTCW=$SELECT(DGBTSL="CAR"&('$PIECE($GET(^DG(43,1,"BT")),U,4)):$PIECE(^PRC(440,DGBTBY,0),U,1),DGBTSL="CAR"&($PIECE($GET(^DG(43,1,"BT")),U,4)):$PIECE(^DGBT(392.31,DGBTBY,0),U,1),1:DGBTCW)
- +1 SET DGBTOTX(DGBTDN,DGBTCW)=$SELECT('$DATA(DGBTOTX(DGBTDN,DGBTCW)):0,1:DGBTOTX(DGBTDN,DGBTCW))
- SET DGBTOTX(DGBTDN,DGBTCW)=DGBTOTX(DGBTDN,DGBTCW)+1
- +2 SET DGBTPTC(DGBTDV)=$SELECT('$DATA(DGBTPTC(DGBTDV)):0,1:DGBTPTC(DGBTDV))
- SET DGBTPTC(DGBTDV)=DGBTPTC(DGBTDV)+1
- +3 SET ^UTILITY($JOB,1,DGBTDN,DGBTCW,DGBTP,SSN,DGBTD)=DGBTP_U_DGBTK10_U_DGBTCH_U_DGBTC_U_DGBTB_U_DGBTK9
- SET DGBTK=^(DGBTD)
- QUIT
- CM NEW X3
- DO COMMA^%DTC
- QUIT
