IBTRED ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY ;01-JUL-1993
;;2.0;INTEGRATED BILLING;**71,91,160,247,309,276,339,363,458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, 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 N IBXR
S VALMHDR(1)="Expanded Claims Tracking Info for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
S IBXR=$$ROIEVT^IBTRR1(IBTRN) I IBXR'="" S VALMHDR(1)=VALMHDR(1)_$J(" ",(60-$L(VALMHDR(1))))_"ROI: "_IBXR
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 D ^IBTRED0,^IBTRED01
Q
;
VISIT ; -- Visit info Region
N OFFSET,START,IBOE,IBOE0
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),IBOE0=$$SCE^IBSDU(+IBOE)
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(IBOE0,"^",4),0)),"^"))
D SET^IBCNSP(START+4,OFFSET," Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P(IBOE0,"^",12)))
D SET^IBCNSP(START+5,OFFSET," Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P(IBOE0,"^",10)))
D SET^IBCNSP(START+6,OFFSET," Special Cond: "_$$ENCL(IBOE))
Q
;
3 ; -- visit region for rx refill
N PSONTALK,PSOTMP,PSOQTY
S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
I '$D(PSOTMP) D PSOCPVW^IBNCPDPC(+$P(IBTRND,"^",2),+$P(IBTRND,"^",8),.PSOTMP)
S PSOQTY=$$NCPDPQTY^PSSBPSUT(+$$RXAPI1^IBNCPUT1(+$P(IBTRND,"^",8),6,"I"),PSOTMP(52,+$P(IBTRND,"^",8),7,"E"))
D SET^IBCNSP(START+2,OFFSET,"Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E")))
;I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),22,"E")))
;I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$G(PSOTMP(52.1,+$P(IBTRND,"^",10),.01,"E")))
I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6)))
I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6)))
D SET^IBCNSP(START+4,OFFSET," Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E")))
D SET^IBCNSP(START+5,OFFSET," Rx Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8))
D SET^IBCNSP(START+6,OFFSET," Bill Quantity: "_$J($P(PSOQTY,"^"),11)_" "_$P(PSOQTY,"^",2))
D SET^IBCNSP(START+7,OFFSET," Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8))
D SET^IBCNSP(START+8,OFFSET," NDC#: "_$$GETNDC^PSONDCUT(+$P(IBTRND,"^",8),$P(IBTRND,"^",10)))
D SET^IBCNSP(START+9,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:8 S X=$P(IBCL1,"^",I) S:X IBCL=IBCL_$S(I=1:"AO",I=2:"IR",I=3:"SC",I=4:"SWA",I=5:"MST",I=6:"HNC",I=7:"CV",I=8:"SHAD",1:"")_" "
ENCLQ Q IBCL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRED 5125 printed Oct 16, 2024@18:28:31 Page 2
IBTRED ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY ;01-JUL-1993
+1 ;;2.0;INTEGRATED BILLING;**71,91,160,247,309,276,339,363,458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, 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
NEW IBXR
+2 SET VALMHDR(1)="Expanded Claims Tracking Info for: "_$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,20)_" "_$EXTRACT($GET(^(0)),1)_VA("BID")
+3 SET IBXR=$$ROIEVT^IBTRR1(IBTRN)
IF IBXR'=""
SET VALMHDR(1)=VALMHDR(1)_$JUSTIFY(" ",(60-$LENGTH(VALMHDR(1))))_"ROI: "_IBXR
+4 SET VALMHDR(2)=" For: "_$$ETYP(IBTRN)
+5 QUIT
+6 ;
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,IBOE0
+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)
SET IBOE0=$$SCE^IBSDU(+IBOE)
+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(IBOE0,"^",4),0)),"^"))
+6 DO SET^IBCNSP(START+4,OFFSET," Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$PIECE(IBOE0,"^",12)))
+7 DO SET^IBCNSP(START+5,OFFSET," Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$PIECE(IBOE0,"^",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,PSOQTY
+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 ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
+5 IF '$DATA(PSOTMP)
DO PSOCPVW^IBNCPDPC(+$PIECE(IBTRND,"^",2),+$PIECE(IBTRND,"^",8),.PSOTMP)
+6 SET PSOQTY=$$NCPDPQTY^PSSBPSUT(+$$RXAPI1^IBNCPUT1(+$PIECE(IBTRND,"^",8),6,"I"),PSOTMP(52,+$PIECE(IBTRND,"^",8),7,"E"))
+7 DO SET^IBCNSP(START+2,OFFSET,"Prescription #: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),.01,"E")))
+8 ;I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),22,"E")))
+9 ;I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$G(PSOTMP(52.1,+$P(IBTRND,"^",10),.01,"E")))
+10 IF $PIECE(IBTRND,"^",10)=0
DO SET^IBCNSP(START+3,OFFSET," Fill Date: "_$$FMTE^XLFDT(+$PIECE(IBTRND,"^",6)))
+11 IF +$PIECE(IBTRND,"^",10)
DO SET^IBCNSP(START+3,OFFSET," Refill Date: "_$$FMTE^XLFDT(+$PIECE(IBTRND,"^",6)))
+12 DO SET^IBCNSP(START+4,OFFSET," Drug: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),6,"E")))
+13 DO SET^IBCNSP(START+5,OFFSET," Rx Quantity: "_$JUSTIFY($GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),7,"E")),8))
+14 DO SET^IBCNSP(START+6,OFFSET," Bill Quantity: "_$JUSTIFY($PIECE(PSOQTY,"^"),11)_" "_$PIECE(PSOQTY,"^",2))
+15 DO SET^IBCNSP(START+7,OFFSET," Days Supply: "_$JUSTIFY($GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),8,"E")),8))
+16 DO SET^IBCNSP(START+8,OFFSET," NDC#: "_$$GETNDC^PSONDCUT(+$PIECE(IBTRND,"^",8),$PIECE(IBTRND,"^",10)))
+17 DO SET^IBCNSP(START+9,OFFSET," Physician: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),4,"E")))
+18 QUIT
+19 ;
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:8
SET X=$PIECE(IBCL1,"^",I)
if X
SET IBCL=IBCL_$SELECT(I=1:"AO",I=2:"IR",I=3:"SC",I=4:"SWA",I=5:"MST",I=6:"HNC",I=7:"CV",I=8:"SHAD",1:"")_" "
ENCLQ QUIT IBCL
+1 ;
