DGBTOA2.m

DGBTOA2 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS (Cont) ;2/21/91  15:57

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;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") D SORT G:DGBTU QUIT1 I $D(^UTILITY($J)) D TOTAL^DGBTOA4 G QUIT1

 W !,"=====>NO PATIENTS FOUND"

QUIT1 D CLOSE^DGUTQ 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))

 S DGBTB=$S($P(DGBTK,U,7):$P(^PRC(440,$P(DGBTK,U,7),0),U,1),1:""),DGBTK9=$P(DGBTK,U,9),DGBTK10=$P(DGBTK,U,10)

 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(^PRC(440,DGBTBY,0),U,1),1:DGBTCW),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 D COMMA^%DTC Q

DGBTOA2   ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS (Cont) ;2/21/91  15:57

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +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")

           DO SORT

           IF DGBTU

               GOTO QUIT1

           IF $DATA(^UTILITY($JOB))

               DO TOTAL^DGBTOA4

               GOTO QUIT1

 +2        WRITE !,"=====>NO PATIENTS FOUND"

QUIT1      DO CLOSE^DGUTQ

           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        SET DGBTB=$SELECT($PIECE(DGBTK,U,7):$PIECE(^PRC(440,$PIECE(DGBTK,U,7),0),U,1),1:"")

           SET DGBTK9=$PIECE(DGBTK,U,9)

           SET DGBTK10=$PIECE(DGBTK,U,10)

 +6        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:"")

 +7        SET (DGBTG,DGBTXX)=0

           SET DGBTI=$SELECT(DGBTSL="PAT":$PIECE(DGBTO,U,1),DGBTSL="CAR":DGBTB,1:DGBTC)

 +8        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

 +9        SET DGBTS=$SELECT($PIECE(DGBTK,U,2):$PIECE(DGBTK,U,2),1:"")

           SET DGBTSD=$SELECT($PIECE(DGBTK,U,6):$PIECE(DGBTK,U,6),1:"")

 +10       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

 +11       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

 +12       IF DGBTSL="PAT"

               SET ^UTILITY($JOB,2,DGBTDN,DGBTP,SSN,"T")=DGBTS_U_DGBTSD_U_SSN

               QUIT 

 +13       SET ^UTILITY($JOB,2,DGBTDN,DGBTCW,"T")=DGBTS_U_DGBTSD_U_DGBTBY

           QUIT 

 +14      ;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(^PRC(440,DGBTBY,0),U,1),1:DGBTCW)

           SET DGBTOTX(DGBTDN,DGBTCW)=$SELECT('$DATA(DGBTOTX(DGBTDN,DGBTCW)):0,1:DGBTOTX(DGBTDN,DGBTCW))

           SET DGBTOTX(DGBTDN,DGBTCW)=DGBTOTX(DGBTDN,DGBTCW)+1

 +1        SET DGBTPTC(DGBTDV)=$SELECT('$DATA(DGBTPTC(DGBTDV)):0,1:DGBTPTC(DGBTDV))

           SET DGBTPTC(DGBTDV)=DGBTPTC(DGBTDV)+1

 +2        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         DO COMMA^%DTC

           QUIT