IBCU2 ;ALB/MRL - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUN 88 12:00
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRU2
;
TC D TCL F DGJ=0:0 S DGJ=$O(^DD(399,201,1,DGJ)) Q:'DGJ I $D(^DD(399,201,1,DGJ,DGXRF)) S DA=DGI(1),X=DGTCX1 X ^(DGXRF)
S DA=DGI,DA(1)=DGI(1),X=DGTCX,$P(^DGCR(399,DA(1),"U1"),"^",12)="" K DGI,DGJ,DGXRF,DGTCX,DGTCX1,DGTCX2 Q
TCL S (DGTCX,DGTCX2)=0 F DGTCX1=0:0 S DGTCX1=$O(^DGCR(399,DA(1),"RC",DGTCX1)) Q:'DGTCX1 I $D(^DGCR(399,DA(1),"RC",DGTCX1,0)),DGTCX1'=DA S DGTCX=DGTCX+$P(^(0),"^",4)
I DGXRF=1 S DGTCX1=DGTCX+X
E S DGTCX1=DGTCX
S $P(^DGCR(399,DA(1),"U1"),"^",1)=DGTCX1,$P(^("U1"),"^",10)=DGTCX1,DGI=DA,DGI(1)=DA(1),DGTCX=X Q
;
TC1 F DGJ1=0:0 S DGJ1=$O(^DD(399.042,.04,1,DGJ1)) Q:'DGJ1 I $D(^DD(399.042,.04,1,DGJ1,DGXRF1)) S X=DGTCX11 X ^(DGXRF1)
S X=DGTCX11 K DGJ1,DGXRF11,DGTCX11 Q
;
FY S DGTCX1=$S($D(^DGCR(399,DA,"U1")):^("U1"),1:0) I +X>+DGTCX1 W !?4,*7,"Exceeds 'Total Charges' for this bill." K X Q
I $P(DGTCX1,"^",11)="" W !?4,*7,"Bill doesn't cross fiscal years...edit revenue codes/from-to dates if",!?4,"appropriate." K X Q
Q
21 ;set logic for CHARGES subfield x-ref (399.042;.02)
I $P(^DGCR(399,DA(1),"RC",DA,0),"^",3)="" S $P(^DGCR(399,DA(1),"RC",DA,0),"^",3)=$S($P(^DGCR(399,DA(1),0),"^",5)<3:$P(^("U"),"^",15),$D(^DGCR(399,DA(1),"OP",0)):$P(^(0),"^",4),1:1)
S Z=X,Z1=$P(^DGCR(399,DA(1),"RC",DA,0),"^",3) S DGTCX11=Z*Z1,$P(^(0),"^",4)=DGTCX11,DGXRF1=1 D TC1
Q
;
22 ;kill logic for CHARGES subfield x-ref (399.042;.02)
S Z=X,Z1=$P(^DGCR(399,DA(1),"RC",DA,0),"^",3) S DGTCX11=Z*Z1,$P(^(0),"^",4)=DGTCX11,DGXRF1=2 D TC1
Q
;
31 ;set logic for UNITS OF SERVICE subfield x-ref (399.042;.03)
S Z=X,Z1=$P(^DGCR(399,DA(1),"RC",DA,0),"^",2) S DGTCX11=Z*Z1,$P(^(0),"^",4)=DGTCX11,DGXRF1=1 D TC1
Q
;
32 ;kill logic for UNITS OF SERVICE subfield x-ref (399.042;.03)
S Z=X,Z1=$P(^DGCR(399,DA(1),"RC",DA,0),"^",2) S DGTCX11=Z*Z1,$P(^(0),"^",4)=DGTCX11,DGXRF1=2 D TC1
Q
;
FMDATES() ; ask for date range
N %DT,X,Y,DT1,DT2 S DT1=""
S %DT="AEX",%DT("A")="START WITH DATE ENTERED: " D ^%DT K %DT I Y<0!($P(Y,".",1)'?7N) G FMDQ
S (%DT(0),DT2)=$P(Y,".",1) I DT2'>DT S %DT("B")="TODAY"
S %DT="AEX",%DT("A")="GO TO DATE ENTERED: " D ^%DT K %DT I Y<0!($P(Y,".",1)'?7N) G FMDQ
S DT1=DT2_"^"_$P(Y,".",1)
FMDQ Q DT1
IBCU2 ;ALB/MRL - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUN 88 12:00
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRU2
+5 ;
TC DO TCL
FOR DGJ=0:0
SET DGJ=$ORDER(^DD(399,201,1,DGJ))
IF 'DGJ
QUIT
IF $DATA(^DD(399,201,1,DGJ,DGXRF))
SET DA=DGI(1)
SET X=DGTCX1
XECUTE ^(DGXRF)
+1 SET DA=DGI
SET DA(1)=DGI(1)
SET X=DGTCX
SET $PIECE(^DGCR(399,DA(1),"U1"),"^",12)=""
KILL DGI,DGJ,DGXRF,DGTCX,DGTCX1,DGTCX2
QUIT
TCL SET (DGTCX,DGTCX2)=0
FOR DGTCX1=0:0
SET DGTCX1=$ORDER(^DGCR(399,DA(1),"RC",DGTCX1))
IF 'DGTCX1
QUIT
IF $DATA(^DGCR(399,DA(1),"RC",DGTCX1,0))
IF DGTCX1'=DA
SET DGTCX=DGTCX+$PIECE(^(0),"^",4)
+1 IF DGXRF=1
SET DGTCX1=DGTCX+X
+2 IF '$TEST
SET DGTCX1=DGTCX
+3 SET $PIECE(^DGCR(399,DA(1),"U1"),"^",1)=DGTCX1
SET $PIECE(^("U1"),"^",10)=DGTCX1
SET DGI=DA
SET DGI(1)=DA(1)
SET DGTCX=X
QUIT
+4 ;
TC1 FOR DGJ1=0:0
SET DGJ1=$ORDER(^DD(399.042,.04,1,DGJ1))
IF 'DGJ1
QUIT
IF $DATA(^DD(399.042,.04,1,DGJ1,DGXRF1))
SET X=DGTCX11
XECUTE ^(DGXRF1)
+1 SET X=DGTCX11
KILL DGJ1,DGXRF11,DGTCX11
QUIT
+2 ;
FY SET DGTCX1=$SELECT($DATA(^DGCR(399,DA,"U1")):^("U1"),1:0)
IF +X>+DGTCX1
WRITE !?4,*7,"Exceeds 'Total Charges' for this bill."
KILL X
QUIT
+1 IF $PIECE(DGTCX1,"^",11)=""
WRITE !?4,*7,"Bill doesn't cross fiscal years...edit revenue codes/from-to dates if",!?4,"appropriate."
KILL X
QUIT
+2 QUIT
21 ;set logic for CHARGES subfield x-ref (399.042;.02)
+1 IF $PIECE(^DGCR(399,DA(1),"RC",DA,0),"^",3)=""
SET $PIECE(^DGCR(399,DA(1),"RC",DA,0),"^",3)=$SELECT($PIECE(^DGCR(399,DA(1),0),"^",5)<3:$PIECE(^("U"),"^",15),$DATA(^DGCR(399,DA(1),"OP",0)):$PIECE(^(0),"^",4),1:1)
+2 SET Z=X
SET Z1=$PIECE(^DGCR(399,DA(1),"RC",DA,0),"^",3)
SET DGTCX11=Z*Z1
SET $PIECE(^(0),"^",4)=DGTCX11
SET DGXRF1=1
DO TC1
+3 QUIT
+4 ;
22 ;kill logic for CHARGES subfield x-ref (399.042;.02)
+1 SET Z=X
SET Z1=$PIECE(^DGCR(399,DA(1),"RC",DA,0),"^",3)
SET DGTCX11=Z*Z1
SET $PIECE(^(0),"^",4)=DGTCX11
SET DGXRF1=2
DO TC1
+2 QUIT
+3 ;
31 ;set logic for UNITS OF SERVICE subfield x-ref (399.042;.03)
+1 SET Z=X
SET Z1=$PIECE(^DGCR(399,DA(1),"RC",DA,0),"^",2)
SET DGTCX11=Z*Z1
SET $PIECE(^(0),"^",4)=DGTCX11
SET DGXRF1=1
DO TC1
+2 QUIT
+3 ;
32 ;kill logic for UNITS OF SERVICE subfield x-ref (399.042;.03)
+1 SET Z=X
SET Z1=$PIECE(^DGCR(399,DA(1),"RC",DA,0),"^",2)
SET DGTCX11=Z*Z1
SET $PIECE(^(0),"^",4)=DGTCX11
SET DGXRF1=2
DO TC1
+2 QUIT
+3 ;
FMDATES() ; ask for date range
+1 NEW %DT,X,Y,DT1,DT2
SET DT1=""
+2 SET %DT="AEX"
SET %DT("A")="START WITH DATE ENTERED: "
DO ^%DT
KILL %DT
IF Y<0!($PIECE(Y,".",1)'?7N)
GOTO FMDQ
+3 SET (%DT(0),DT2)=$PIECE(Y,".",1)
IF DT2'>DT
SET %DT("B")="TODAY"
+4 SET %DT="AEX"
SET %DT("A")="GO TO DATE ENTERED: "
DO ^%DT
KILL %DT
IF Y<0!($PIECE(Y,".",1)'?7N)
GOTO FMDQ
+5 SET DT1=DT2_"^"_$PIECE(Y,".",1)
FMDQ QUIT DT1
