Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRED

IBTRED.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. % ;
  1. EN ; -- main entry point for IBT EXPAND/EDIT TRACKING
  1. I '$D(DT) D DT^DICRW
  1. K XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD
  1. I '$G(IBTRN) G EN^IBTRE Q ; entry from programmer mode
  1. D EN^VALM("IBT EXPAND/EDIT TRACKING")
  1. K IBFASTXT
  1. Q
  1. ;
  1. HDR ; -- header code
  1. D PID^VADPT N IBXR
  1. S VALMHDR(1)="Expanded Claims Tracking Info for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
  1. S IBXR=$$ROIEVT^IBTRR1(IBTRN) I IBXR'="" S VALMHDR(1)=VALMHDR(1)_$J(" ",(60-$L(VALMHDR(1))))_"ROI: "_IBXR
  1. S VALMHDR(2)=" For: "_$$ETYP(IBTRN)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K VALMQUIT
  1. S VALMCNT=0,VALMBG=1
  1. D BLD,HDR
  1. Q
  1. ;
  1. BLD ; -- list builder
  1. N IBTRND,IBTRND1,IBTRND2,IBETYP
  1. K ^TMP("IBTRED",$J)
  1. F I=1:1:30 D BLANK(.I)
  1. I '$G(IBTRPRF) S IBTRPRF=123
  1. 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)
  1. D KILL^VALM10()
  1. S IBTRND=$G(^IBT(356,IBTRN,0)),IBTRND1=$G(^(1))
  1. S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
  1. S VALMCNT=30
  1. D VISIT D ^IBTRED0,^IBTRED01
  1. Q
  1. ;
  1. VISIT ; -- Visit info Region
  1. N OFFSET,START,IBOE,IBOE0
  1. S START=1,OFFSET=2
  1. D SET^IBCNSP(START,OFFSET," Visit Information ",IORVON,IORVOFF)
  1. D SET^IBCNSP(START+1,OFFSET," Visit Type: "_$P(IBETYP,"^"))
  1. I '$D(IBETYP) N IBETYP S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
  1. S X=$P(IBETYP,"^",3) D @X
  1. Q
  1. 1 ; -- visit region for admission or scheduled admission
  1. I $P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17) S VAINDT=+$G(^DGPM(+$P(IBTRND,"^",5),0))
  1. I '$D(VAIN) S VA200="" D INP^VADPT
  1. I VAIN(7)="" S Y=$P(IBTRND,"^",6) D D^DIQ S $P(VAIN(7),"^",2)=Y
  1. D SET^IBCNSP(START+2,OFFSET,"Admission Date: "_$P(VAIN(7),"^",2))
  1. D SET^IBCNSP(START+3,OFFSET," Ward: "_$P(VAIN(4),"^",2))
  1. D SET^IBCNSP(START+4,OFFSET," Specialty: "_$P(VAIN(3),"^",2))
  1. Q
  1. 2 ; -- visit region for outpatient care
  1. S IBOE=$P(IBTRND,"^",4),IBOE0=$$SCE^IBSDU(+IBOE)
  1. D SET^IBCNSP(START+2,OFFSET," Visit Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P"))
  1. I +IBOE<1 D Q
  1. .D SET^IBCNSP(START+3,OFFSET," No Outpatient Encounter Found") Q
  1. D SET^IBCNSP(START+3,OFFSET," Clinic: "_$P($G(^SC(+$P(IBOE0,"^",4),0)),"^"))
  1. D SET^IBCNSP(START+4,OFFSET," Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P(IBOE0,"^",12)))
  1. D SET^IBCNSP(START+5,OFFSET," Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P(IBOE0,"^",10)))
  1. D SET^IBCNSP(START+6,OFFSET," Special Cond: "_$$ENCL(IBOE))
  1. Q
  1. ;
  1. 3 ; -- visit region for rx refill
  1. N PSONTALK,PSOTMP,PSOQTY
  1. S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
  1. S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
  1. ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
  1. I '$D(PSOTMP) D PSOCPVW^IBNCPDPC(+$P(IBTRND,"^",2),+$P(IBTRND,"^",8),.PSOTMP)
  1. S PSOQTY=$$NCPDPQTY^PSSBPSUT(+$$RXAPI1^IBNCPUT1(+$P(IBTRND,"^",8),6,"I"),PSOTMP(52,+$P(IBTRND,"^",8),7,"E"))
  1. D SET^IBCNSP(START+2,OFFSET,"Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E")))
  1. ;I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),22,"E")))
  1. ;I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$G(PSOTMP(52.1,+$P(IBTRND,"^",10),.01,"E")))
  1. I $P(IBTRND,"^",10)=0 D SET^IBCNSP(START+3,OFFSET," Fill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6)))
  1. I +$P(IBTRND,"^",10) D SET^IBCNSP(START+3,OFFSET," Refill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6)))
  1. D SET^IBCNSP(START+4,OFFSET," Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E")))
  1. D SET^IBCNSP(START+5,OFFSET," Rx Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8))
  1. D SET^IBCNSP(START+6,OFFSET," Bill Quantity: "_$J($P(PSOQTY,"^"),11)_" "_$P(PSOQTY,"^",2))
  1. D SET^IBCNSP(START+7,OFFSET," Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8))
  1. D SET^IBCNSP(START+8,OFFSET," NDC#: "_$$GETNDC^PSONDCUT(+$P(IBTRND,"^",8),$P(IBTRND,"^",10)))
  1. D SET^IBCNSP(START+9,OFFSET," Physician: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),4,"E")))
  1. Q
  1. ;
  1. 4 ; -- Visit region for prosthetics
  1. D 4^IBTRED01
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K VALMQUIT,IBTRN
  1. D CLEAN^VALM10,FULL^VALM1
  1. Q
  1. ;
  1. BLANK(LINE) ; -- Build blank line
  1. D SET^VALM10(.LINE,$J("",80))
  1. Q
  1. ;
  1. ETYP(IBTRN) ; -- Expand type of epidose and date
  1. N IBY S IBY=""
  1. S IBTRND=$G(^IBT(356,+IBTRN,0)) I IBTRND="" G ETYPQ
  1. S IBETYPD=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
  1. I IBETYPD="" G ETYPQ
  1. S IBY=$P(IBETYPD,"^")_" on "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
  1. ETYPQ Q IBY
  1. ;
  1. ENCL(IBOE) ; -- output format of classifications
  1. N I,X,IBCL,IBCL1 S IBCL=""
  1. I '$G(IBOE) G ENCLQ
  1. S IBCL1=$$ENCL^IBAMTS2(+IBOE)
  1. 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:"")_" "
  1. ENCLQ Q IBCL
  1. ;