IBTRED ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY ; 01-JUL-1993
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% ;
EN ; -- main entry point for IBT EXPAND/EDIT TRACKING
I '$D(DT) D DT^DICRW
K XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD
I '$G(IBTRN) G EN^IBTRE Q ; entry from programmer mode
D EN^VALM("IBT EXPAND/EDIT TRACKING")
K IBFASTXT
Q
;
HDR ; -- header code
D PID^VADPT
S VALMHDR(1)="Expanded Claims Tracking Info for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")_" ROI: "_$$EXPAND^IBTRE(356,.31,$P(^IBT(356,IBTRN,0),"^",31))
S VALMHDR(2)=" For: "_$$ETYP(IBTRN)
Q
;
INIT ; -- init variables and list array
K VALMQUIT
S VALMCNT=0,VALMBG=1
D BLD,HDR
Q
;
BLD ; -- list builder
N IBTRND,IBTRND1,IBTRND2,IBETYP
K ^TMP("IBTRED",$J)
F I=1:1:30 D BLANK(.I)
I '$G(IBTRPRF) S IBTRPRF=123
I IBTRPRF<10 S X=$S(IBTRPRF=1:"IBTRED HR MENU",IBTRPRF=2:"IBTRED IR MENU",IBTRPRF=3:"IBTRED BI MENU",1:"IBTRED MENU") D PROT^IBTRPR(X)
D KILL^VALM10()
S IBTRND=$G(^IBT(356,IBTRN,0)),IBTRND1=$G(^(1))
S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
S VALMCNT=30
D VISIT,^IBTRED0,^IBTRED01
Q
;
VISIT ; -- Visit info Region
N OFFSET,START,IBOE
S START=1,OFFSET=2
D SET^IBCNSP(START,OFFSET," Visit Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Visit Type: "_$P(IBETYP,"^"))
I '$D(IBETYP) N IBETYP S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
S X=$P(IBETYP,"^",3) D @X
Q
1 ; -- visit region for admission or scheduled admission
I $P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17) S VAINDT=+$G(^DGPM(+$P(IBTRND,"^",5),0))
I '$D(VAIN) S VA200="" D INP^VADPT
I VAIN(7)="" S Y=$P(IBTRND,"^",6) D D^DIQ S $P(VAIN(7),"^",2)=Y
D SET^IBCNSP(START+2,OFFSET,"Admission Date: "_$P(VAIN(7),"^",2))
D SET^IBCNSP(START+3,OFFSET," Ward: "_$P(VAIN(4),"^",2))
D SET^IBCNSP(START+4,OFFSET," Specialty: "_$P(VAIN(3),"^",2))
Q
2 ; -- visit region for outpatient care
S IBOE=$P(IBTRND,"^",4)
D SET^IBCNSP(START+2,OFFSET," Visit Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P"))
I +IBOE<1 D Q
.D SET^IBCNSP(START+3,OFFSET," No Outpatient Encounter Found") Q
D SET^IBCNSP(START+3,OFFSET," Clinic: "_$P($G(^SC(+$P($G(^SCE(+IBOE,0)),"^",4),0)),"^"))
D SET^IBCNSP(START+4,OFFSET," Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P($G(^SCE(+IBOE,0)),"^",12)))
D SET^IBCNSP(START+5,OFFSET," Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P($G(^SCE(+IBOE,0)),"^",10)))
D SET^IBCNSP(START+6,OFFSET," Special Cond: "_$$ENCL(IBOE))
Q
;
3 ; -- visit region for rx refill
N PSONTALK,PSOTMP
S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
D SET^IBCNSP(START+2,OFFSET,"Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E")))
D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$G(PSOTMP(52.1,+$P(IBTRND,"^",10),.01,"E")))
D SET^IBCNSP(START+4,OFFSET," Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E")))
D SET^IBCNSP(START+5,OFFSET," Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8))
D SET^IBCNSP(START+6,OFFSET," Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8))
D SET^IBCNSP(START+7,OFFSET," NDC#: "_$P($G(^PSDRUG(+$P($G(^PSRX(+$P(IBTRND,"^",8),0)),"^",6),2)),"^",4))
D SET^IBCNSP(START+8,OFFSET," Physician: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),4,"E")))
Q
;
4 ; -- Visit region for prosthetics
D 4^IBTRED01
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K VALMQUIT,IBTRN
D CLEAN^VALM10,FULL^VALM1
Q
;
BLANK(LINE) ; -- Build blank line
D SET^VALM10(.LINE,$J("",80))
Q
;
ETYP(IBTRN) ; -- Expand type of epidose and date
N IBY S IBY=""
S IBTRND=$G(^IBT(356,+IBTRN,0)) I IBTRND="" G ETYPQ
S IBETYPD=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
I IBETYPD="" G ETYPQ
S IBY=$P(IBETYPD,"^")_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
ETYPQ Q IBY
;
ENCL(IBOE) ; -- output format of classifications
N I,X,IBCL,IBCL1 S IBCL=""
I '$G(IBOE) G ENCLQ
S IBCL1=$$ENCL^IBAMTS2(+IBOE)
F I=1:1:4 S X=$P(IBCL1,"^",I) S:X IBCL=IBCL_$S(I=1:"AO",I=2:"SC",I=3:"IR",I=4:"EC",1:"")_" "
ENCLQ Q IBCL
IBTRED ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY ; 01-JUL-1993
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% ;
EN ; -- main entry point for IBT EXPAND/EDIT TRACKING
+1 IF '$DATA(DT)
DO DT^DICRW
+2 KILL XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD
+3 ; entry from programmer mode
IF '$GET(IBTRN)
GOTO EN^IBTRE
QUIT
+4 DO EN^VALM("IBT EXPAND/EDIT TRACKING")
+5 KILL IBFASTXT
+6 QUIT
+7 ;
HDR ; -- header code
+1 DO PID^VADPT
+2 SET VALMHDR(1)="Expanded Claims Tracking Info for: "_$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,20)_" "_$EXTRACT($GET(^(0)),1)_VA("BID")_" ROI: "_$$EXPAND^IBTRE(356,.31,$PIECE(^IBT(356,IBTRN,0),"^",31))
+3 SET VALMHDR(2)=" For: "_$$ETYP(IBTRN)
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 KILL VALMQUIT
+2 SET VALMCNT=0
SET VALMBG=1
+3 DO BLD
DO HDR
+4 QUIT
+5 ;
BLD ; -- list builder
+1 NEW IBTRND,IBTRND1,IBTRND2,IBETYP
+2 KILL ^TMP("IBTRED",$JOB)
+3 FOR I=1:1:30
DO BLANK(.I)
+4 IF '$GET(IBTRPRF)
SET IBTRPRF=123
+5 IF IBTRPRF<10
SET X=$SELECT(IBTRPRF=1:"IBTRED HR MENU",IBTRPRF=2:"IBTRED IR MENU",IBTRPRF=3:"IBTRED BI MENU",1:"IBTRED MENU")
DO PROT^IBTRPR(X)
+6 DO KILL^VALM10()
+7 SET IBTRND=$GET(^IBT(356,IBTRN,0))
SET IBTRND1=$GET(^(1))
+8 SET IBETYP=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
+9 SET VALMCNT=30
+10 DO VISIT
DO ^IBTRED0
DO ^IBTRED01
+11 QUIT
+12 ;
VISIT ; -- Visit info Region
+1 NEW OFFSET,START,IBOE
+2 SET START=1
SET OFFSET=2
+3 DO SET^IBCNSP(START,OFFSET," Visit Information ",IORVON,IORVOFF)
+4 DO SET^IBCNSP(START+1,OFFSET," Visit Type: "_$PIECE(IBETYP,"^"))
+5 IF '$DATA(IBETYP)
NEW IBETYP
SET IBETYP=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
+6 SET X=$PIECE(IBETYP,"^",3)
DO @X
+7 QUIT
1 ; -- visit region for admission or scheduled admission
+1 IF $PIECE($GET(^DGPM(+$PIECE(IBTRND,"^",5),0)),"^",17)
SET VAINDT=+$GET(^DGPM(+$PIECE(IBTRND,"^",5),0))
+2 IF '$DATA(VAIN)
SET VA200=""
DO INP^VADPT
+3 IF VAIN(7)=""
SET Y=$PIECE(IBTRND,"^",6)
DO D^DIQ
SET $PIECE(VAIN(7),"^",2)=Y
+4 DO SET^IBCNSP(START+2,OFFSET,"Admission Date: "_$PIECE(VAIN(7),"^",2))
+5 DO SET^IBCNSP(START+3,OFFSET," Ward: "_$PIECE(VAIN(4),"^",2))
+6 DO SET^IBCNSP(START+4,OFFSET," Specialty: "_$PIECE(VAIN(3),"^",2))
+7 QUIT
2 ; -- visit region for outpatient care
+1 SET IBOE=$PIECE(IBTRND,"^",4)
+2 DO SET^IBCNSP(START+2,OFFSET," Visit Date: "_$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),"2P"))
+3 IF +IBOE<1
Begin DoDot:1
+4 DO SET^IBCNSP(START+3,OFFSET," No Outpatient Encounter Found")
QUIT
End DoDot:1
QUIT
+5 DO SET^IBCNSP(START+3,OFFSET," Clinic: "_$PIECE($GET(^SC(+$PIECE($GET(^SCE(+IBOE,0)),"^",4),0)),"^"))
+6 DO SET^IBCNSP(START+4,OFFSET," Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$PIECE($GET(^SCE(+IBOE,0)),"^",12)))
+7 DO SET^IBCNSP(START+5,OFFSET," Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$PIECE($GET(^SCE(+IBOE,0)),"^",10)))
+8 DO SET^IBCNSP(START+6,OFFSET," Special Cond: "_$$ENCL(IBOE))
+9 QUIT
+10 ;
3 ; -- visit region for rx refill
+1 NEW PSONTALK,PSOTMP
+2 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
SET PSONTALK=1
+3 SET X=+$PIECE(IBTRND,"^",8)_"^"_+$PIECE(IBTRND,"^",10)
DO EN^PSOCPVW
+4 DO SET^IBCNSP(START+2,OFFSET,"Prescription #: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),.01,"E")))
+5 DO SET^IBCNSP(START+3,OFFSET," Refill Date: "_$GET(PSOTMP(52.1,+$PIECE(IBTRND,"^",10),.01,"E")))
+6 DO SET^IBCNSP(START+4,OFFSET," Drug: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),6,"E")))
+7 DO SET^IBCNSP(START+5,OFFSET," Quantity: "_$JUSTIFY($GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),7,"E")),8))
+8 DO SET^IBCNSP(START+6,OFFSET," Days Supply: "_$JUSTIFY($GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),8,"E")),8))
+9 DO SET^IBCNSP(START+7,OFFSET," NDC#: "_$PIECE($GET(^PSDRUG(+$PIECE($GET(^PSRX(+$PIECE(IBTRND,"^",8),0)),"^",6),2)),"^",4))
+10 DO SET^IBCNSP(START+8,OFFSET," Physician: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),4,"E")))
+11 QUIT
+12 ;
4 ; -- Visit region for prosthetics
+1 DO 4^IBTRED01
+2 QUIT
+3 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL VALMQUIT,IBTRN
+2 DO CLEAN^VALM10
DO FULL^VALM1
+3 QUIT
+4 ;
BLANK(LINE) ; -- Build blank line
+1 DO SET^VALM10(.LINE,$JUSTIFY("",80))
+2 QUIT
+3 ;
ETYP(IBTRN) ; -- Expand type of epidose and date
+1 NEW IBY
SET IBY=""
+2 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
IF IBTRND=""
GOTO ETYPQ
+3 SET IBETYPD=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
+4 IF IBETYPD=""
GOTO ETYPQ
+5 SET IBY=$PIECE(IBETYPD,"^")_" on "_$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),"2P")
ETYPQ QUIT IBY
+1 ;
ENCL(IBOE) ; -- output format of classifications
+1 NEW I,X,IBCL,IBCL1
SET IBCL=""
+2 IF '$GET(IBOE)
GOTO ENCLQ
+3 SET IBCL1=$$ENCL^IBAMTS2(+IBOE)
+4 FOR I=1:1:4
SET X=$PIECE(IBCL1,"^",I)
IF X
SET IBCL=IBCL_$SELECT(I=1:"AO",I=2:"SC",I=3:"IR",I=4:"EC",1:"")_" "
ENCLQ QUIT IBCL
