- 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 Jan 18, 2025@03:29:05 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 ;