- IBCEF74A ;ALB/ESG - Provider ID maint ?ID continuation ;7 Mar 2006
- ;;2.0;INTEGRATED BILLING;**320,343,349,395,400,432,516,592**;21-MAR-94;Build 58
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- EN(IBIFN,IBQUIT,IBID) ; Display billing provider and service provider IDs as part
- ; of the ?ID display/help in the billing screens.
- ; Called from DISPID^IBCEF74.
- NEW IBX,Z,ZI,ZN,SEQ,PSIN,DATA,QUALNM,IDNUM,FACNAME,IBZ,ORGNPI,BPZ,BPNAME,BPNPI,BPTAX,SFNPI,SFTAX
- ;
- ;D ALLIDS^IBCEF75(IBIFN,.IBID)
- ;
- ; Re-sort array by insurance sequence (P/S/T)
- K IBX
- F Z="BILLING PRV","LAB/FAC" F ZI="C","O" S ZN=0 F S ZN=$O(IBID(Z,IBIFN,ZI,ZN)) Q:'ZN D
- . S SEQ=$P($G(IBID(Z,IBIFN,ZI,ZN)),U,1) Q:SEQ=""
- . S IBX(Z,SEQ,ZI,ZN)=""
- . Q
- ;
- ; Display billing provider information - IB*2*400
- S BPZ=$$B^IBCEF79(IBIFN)
- D GETBP^IBCEF79(IBIFN,"",+BPZ,"?ID",.IBZ)
- S ORGNPI=$$ORGNPI^IBCEF73A(IBIFN)
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !!,"Billing Provider Name and ID Information"
- S BPNAME=$G(IBZ("?ID","NAME"))
- I BPNAME="" S BPNAME="***MISSING***"
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !,"Billing Provider: ",BPNAME
- ;
- S BPNPI=$P(ORGNPI,U,3)
- I BPNPI="" S BPNPI="***MISSING***"
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Billing Provider NPI: ",BPNPI
- ;
- S BPTAX=$$NOPUNCT^IBCEF($P($G(^IBE(350.9,1,1)),U,5),1)
- I BPTAX="" S BPTAX="***MISSING***"
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Billing Provider Tax ID (VistA Record PRV): ",BPTAX
- ;
- ; Display billing provider secondary ID's (current ins only)
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Billing Provider Secondary IDs (VistA Record CI1A):"
- S Z="BILLING PRV"
- D SECID(Z,.IBQUIT)
- I IBQUIT G EX
- ;
- ; Now display the lab or facility primary and secondary IDs
- ; This is the service facility information
- ; IB*2*400 - check to make sure there is a service facility
- ;
- I $P(BPZ,U,3)="" G LPRV ; no service facility information to display
- ;
- ; Service facility name, similar code as found in SUB-2
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !!,"Service Facility Name and ID Information"
- ;
- ; MRD;IB*2.0*516 - Due to fields being marked for deletion, the
- ; function $$SENDSF^IBCEF79 will always return '1'. Refer to
- ; that function and INSFLGS^IBCEF79 for more information.
- ;
- ; Display note if ins co flag to suppress lab/fac data is set (only applies in switchback mode)
- ;I '$$SENDSF^IBCEF79(IBIFN) D I IBQUIT G EX
- ;. I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT
- ;. W !!,"Note: Service Facility Data not sent for Current Insurance"
- ;. W !," 'Send VA Lab/Facility IDs or Facility Data for VAMC?' is set to NO",!
- ;. Q
- ;
- S FACNAME=$$GETFAC^IBCEP8(+$P(BPZ,U,4),$P(BPZ,U,3),0)
- I FACNAME="" S FACNAME="***MISSING***"
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Facility: ",FACNAME
- ;
- S SFNPI=$P(ORGNPI,U,1)
- I SFNPI="" S SFNPI="***MISSING***"
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Lab or Facility NPI: ",SFNPI
- ;
- S SFTAX=$$NOPUNCT^IBCEF($$EIN^IBCEP8A(IBIFN),1)
- I SFTAX="" S SFTAX="***MISSING***"
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Lab or Facility Tax ID (VistA Record SUB): ",SFTAX
- ;
- ; lab/fac secondary IDs
- I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX
- W !?5,"Lab or Facility Secondary IDs (VistA Records SUB1,SUB2,OP3,OP6,OP7):"
- S Z="LAB/FAC"
- D SECID(Z,.IBQUIT)
- I IBQUIT G EX
- ;
- LPRV ;Service Line Providers
- I '$D(IBID("L-PROV")) G EX ; No Line Level Providers
- N IBSLC,IBN,CO,IBCODE,IBTYP,IBPRTYP,Z0
- S IBSLC=0
- W !!,"Service Line Providers"
- F S IBSLC=$O(IBID("L-PROV",IBIFN,IBSLC)) Q:'IBSLC D I IBQUIT Q
- . I ($Y+6)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT Q
- . W !!?5,"Service Line: ",IBSLC
- . ;JWS;IB*2.0*592; 6 - Assistant Surgeon
- . F IBPRTYP=4,3,1,2,5,6,9 I $D(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP)) D ; Process providers in order: Attending, Rendering, Referring, Operating, Supervising, Assistant Surgeon and Other Operating if they exist
- .. I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT Q
- .. W !?5,$$EXTERNAL^DILFD(399.0404,.01,"",IBPRTYP),": ",$$EXTERNAL^DILFD(399.0404,.02,"",$P(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP),U,1))
- .. W !?8,"NPI:",?40,$S($P(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP,0),U,4)]"":$P(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP,0),U,4),1:"***MISSING***")
- .. K IBTYP
- .. F CO="C","O" D
- ... F IBN=1,2 D
- .... F Z0=1:1 Q:'$D(IBID("L-PROV",IBIFN,IBSLC,CO,IBN,IBPRTYP,Z0))!IBQUIT D
- ..... S IBCODE=$P(IBID("L-PROV",IBIFN,IBSLC,CO,IBN,IBPRTYP,Z0),U,9)
- ..... Q:$D(IBTYP(IBCODE)) ; 1st of each type transmits
- ..... I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT
- ..... S IBTYP(IBCODE)=""
- ..... W !,?8,"(",IBID("L-PROV",IBIFN,IBSLC,CO,IBN),") ",$$EXTERNAL^DILFD(36,4.01,"",IBCODE),?40,$P(IBID("L-PROV",IBIFN,IBSLC,CO,IBN,IBPRTYP,Z0),U,4)
- ;
- EX ;
- Q
- ;
- QUAL(Z,FORMTYPE) ; turn the qualifier code into a qualifier description
- NEW QUAL,IEN
- S QUAL=""
- I $G(Z)="" G QUALX
- I Z="1C" D G QUALX ; qualifier for Medicare Part ?
- . I $G(FORMTYPE)=2 S QUAL="MEDICARE PART B" ; 1500
- . I $G(FORMTYPE)=3 S QUAL="MEDICARE PART A" ; ub
- . Q
- I Z=34 S Z="SY" ; qualifier for SSN
- S IEN=+$O(^IBE(355.97,"C",Z,"")) I 'IEN G QUALX
- S QUAL=$P($G(^IBE(355.97,IEN,0)),U,1)
- QUALX ;
- Q QUAL
- ;
- SECID(Z,IBQUIT) ; Display secondary ID and qualifier information
- ; Z is the type of IDs passed in; either BILLING PRV or LAB/FAC
- ; IBQUIT is returned if passed by reference
- NEW SEQ,ZI,ZN,PSIN,DATA,QUALNM,IDNUM,NODATA
- S IBQUIT=0,NODATA=1
- F SEQ="P","S","T" D Q:IBQUIT
- . ;
- . ; current ins only for billing provider secondary IDs
- . I Z="BILLING PRV",SEQ'=$$COB^IBCEF(IBIFN) Q
- . S ZI=""
- . F S ZI=$O(IBX(Z,SEQ,ZI)) Q:ZI="" D Q:IBQUIT
- .. S ZN=0
- .. F S ZN=$O(IBX(Z,SEQ,ZI,ZN)) Q:'ZN D Q:IBQUIT
- ... S PSIN=0 ; start at 0 to skip primary IDs
- ... ;*432/TAZ - Changed Q:PSIN="" to Q:'PSIN to prevent "CONTACTS" node from printing as secondary ID
- ... F S PSIN=$O(IBID(Z,IBIFN,ZI,ZN,PSIN)) Q:'PSIN D Q:IBQUIT
- .... S DATA=$G(IBID(Z,IBIFN,ZI,ZN,PSIN))
- .... S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN))
- .... S IDNUM=$P(DATA,U,2)
- .... I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT
- .... S NODATA=0
- .... W !?8,"(",SEQ,") ",QUALNM,?40,IDNUM
- .... I Z="LAB/FAC",$D(^DGCR(399,IBIFN,"I2")),SEQ=$$COB^IBCEF(IBIFN) W ?54,"<<<Current Ins"
- .... I Z="BILLING PRV",PSIN=1 W ?54,"<<<System Generated ID"
- .... Q
- ... Q
- .. Q
- . Q
- I NODATA,'IBQUIT W !?8,"(-) None Found"
- SECIDX ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF74A 6724 printed Jan 18, 2025@03:11:29 Page 2
- IBCEF74A ;ALB/ESG - Provider ID maint ?ID continuation ;7 Mar 2006
- +1 ;;2.0;INTEGRATED BILLING;**320,343,349,395,400,432,516,592**;21-MAR-94;Build 58
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- EN(IBIFN,IBQUIT,IBID) ; Display billing provider and service provider IDs as part
- +1 ; of the ?ID display/help in the billing screens.
- +2 ; Called from DISPID^IBCEF74.
- +3 NEW IBX,Z,ZI,ZN,SEQ,PSIN,DATA,QUALNM,IDNUM,FACNAME,IBZ,ORGNPI,BPZ,BPNAME,BPNPI,BPTAX,SFNPI,SFTAX
- +4 ;
- +5 ;D ALLIDS^IBCEF75(IBIFN,.IBID)
- +6 ;
- +7 ; Re-sort array by insurance sequence (P/S/T)
- +8 KILL IBX
- +9 FOR Z="BILLING PRV","LAB/FAC"
- FOR ZI="C","O"
- SET ZN=0
- FOR
- SET ZN=$ORDER(IBID(Z,IBIFN,ZI,ZN))
- if 'ZN
- QUIT
- Begin DoDot:1
- +10 SET SEQ=$PIECE($GET(IBID(Z,IBIFN,ZI,ZN)),U,1)
- if SEQ=""
- QUIT
- +11 SET IBX(Z,SEQ,ZI,ZN)=""
- +12 QUIT
- End DoDot:1
- +13 ;
- +14 ; Display billing provider information - IB*2*400
- +15 SET BPZ=$$B^IBCEF79(IBIFN)
- +16 DO GETBP^IBCEF79(IBIFN,"",+BPZ,"?ID",.IBZ)
- +17 SET ORGNPI=$$ORGNPI^IBCEF73A(IBIFN)
- +18 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +19 WRITE !!,"Billing Provider Name and ID Information"
- +20 SET BPNAME=$GET(IBZ("?ID","NAME"))
- +21 IF BPNAME=""
- SET BPNAME="***MISSING***"
- +22 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +23 WRITE !,"Billing Provider: ",BPNAME
- +24 ;
- +25 SET BPNPI=$PIECE(ORGNPI,U,3)
- +26 IF BPNPI=""
- SET BPNPI="***MISSING***"
- +27 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +28 WRITE !?5,"Billing Provider NPI: ",BPNPI
- +29 ;
- +30 SET BPTAX=$$NOPUNCT^IBCEF($PIECE($GET(^IBE(350.9,1,1)),U,5),1)
- +31 IF BPTAX=""
- SET BPTAX="***MISSING***"
- +32 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +33 WRITE !?5,"Billing Provider Tax ID (VistA Record PRV): ",BPTAX
- +34 ;
- +35 ; Display billing provider secondary ID's (current ins only)
- +36 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +37 WRITE !?5,"Billing Provider Secondary IDs (VistA Record CI1A):"
- +38 SET Z="BILLING PRV"
- +39 DO SECID(Z,.IBQUIT)
- +40 IF IBQUIT
- GOTO EX
- +41 ;
- +42 ; Now display the lab or facility primary and secondary IDs
- +43 ; This is the service facility information
- +44 ; IB*2*400 - check to make sure there is a service facility
- +45 ;
- +46 ; no service facility information to display
- IF $PIECE(BPZ,U,3)=""
- GOTO LPRV
- +47 ;
- +48 ; Service facility name, similar code as found in SUB-2
- +49 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +50 WRITE !!,"Service Facility Name and ID Information"
- +51 ;
- +52 ; MRD;IB*2.0*516 - Due to fields being marked for deletion, the
- +53 ; function $$SENDSF^IBCEF79 will always return '1'. Refer to
- +54 ; that function and INSFLGS^IBCEF79 for more information.
- +55 ;
- +56 ; Display note if ins co flag to suppress lab/fac data is set (only applies in switchback mode)
- +57 ;I '$$SENDSF^IBCEF79(IBIFN) D I IBQUIT G EX
- +58 ;. I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT
- +59 ;. W !!,"Note: Service Facility Data not sent for Current Insurance"
- +60 ;. W !," 'Send VA Lab/Facility IDs or Facility Data for VAMC?' is set to NO",!
- +61 ;. Q
- +62 ;
- +63 SET FACNAME=$$GETFAC^IBCEP8(+$PIECE(BPZ,U,4),$PIECE(BPZ,U,3),0)
- +64 IF FACNAME=""
- SET FACNAME="***MISSING***"
- +65 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +66 WRITE !?5,"Facility: ",FACNAME
- +67 ;
- +68 SET SFNPI=$PIECE(ORGNPI,U,1)
- +69 IF SFNPI=""
- SET SFNPI="***MISSING***"
- +70 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +71 WRITE !?5,"Lab or Facility NPI: ",SFNPI
- +72 ;
- +73 SET SFTAX=$$NOPUNCT^IBCEF($$EIN^IBCEP8A(IBIFN),1)
- +74 IF SFTAX=""
- SET SFTAX="***MISSING***"
- +75 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +76 WRITE !?5,"Lab or Facility Tax ID (VistA Record SUB): ",SFTAX
- +77 ;
- +78 ; lab/fac secondary IDs
- +79 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- GOTO EX
- +80 WRITE !?5,"Lab or Facility Secondary IDs (VistA Records SUB1,SUB2,OP3,OP6,OP7):"
- +81 SET Z="LAB/FAC"
- +82 DO SECID(Z,.IBQUIT)
- +83 IF IBQUIT
- GOTO EX
- +84 ;
- LPRV ;Service Line Providers
- +1 ; No Line Level Providers
- IF '$DATA(IBID("L-PROV"))
- GOTO EX
- +2 NEW IBSLC,IBN,CO,IBCODE,IBTYP,IBPRTYP,Z0
- +3 SET IBSLC=0
- +4 WRITE !!,"Service Line Providers"
- +5 FOR
- SET IBSLC=$ORDER(IBID("L-PROV",IBIFN,IBSLC))
- if 'IBSLC
- QUIT
- Begin DoDot:1
- +6 IF ($Y+6)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- QUIT
- +7 WRITE !!?5,"Service Line: ",IBSLC
- +8 ;JWS;IB*2.0*592; 6 - Assistant Surgeon
- +9 ; Process providers in order: Attending, Rendering, Referring, Operating, Supervising, Assistant Surgeon and Other Operating if they exist
- FOR IBPRTYP=4,3,1,2,5,6,9
- IF $DATA(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP))
- Begin DoDot:2
- +10 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- IF IBQUIT
- QUIT
- +11 WRITE !?5,$$EXTERNAL^DILFD(399.0404,.01,"",IBPRTYP),": ",$$EXTERNAL^DILFD(399.0404,.02,"",$PIECE(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP),U,1))
- +12 WRITE !?8,"NPI:",?40,$SELECT($PIECE(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP,0),U,4)]"":$PIECE(IBID("L-PROV",IBIFN,IBSLC,"C",1,IBPRTYP,0),U,4),1:"***MISSING***")
- +13 KILL IBTYP
- +14 FOR CO="C","O"
- Begin DoDot:3
- +15 FOR IBN=1,2
- Begin DoDot:4
- +16 FOR Z0=1:1
- if '$DATA(IBID("L-PROV",IBIFN,IBSLC,CO,IBN,IBPRTYP,Z0))!IBQUIT
- QUIT
- Begin DoDot:5
- +17 SET IBCODE=$PIECE(IBID("L-PROV",IBIFN,IBSLC,CO,IBN,IBPRTYP,Z0),U,9)
- +18 ; 1st of each type transmits
- if $DATA(IBTYP(IBCODE))
- QUIT
- +19 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- if IBQUIT
- QUIT
- +20 SET IBTYP(IBCODE)=""
- +21 WRITE !,?8,"(",IBID("L-PROV",IBIFN,IBSLC,CO,IBN),") ",$$EXTERNAL^DILFD(36,4.01,"",IBCODE),?40,$PIECE(IBID("L-PROV",IBIFN,IBSLC,CO,IBN,IBPRTYP,Z0),U,4)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IF IBQUIT
- QUIT
- +22 ;
- EX ;
- +1 QUIT
- +2 ;
- QUAL(Z,FORMTYPE) ; turn the qualifier code into a qualifier description
- +1 NEW QUAL,IEN
- +2 SET QUAL=""
- +3 IF $GET(Z)=""
- GOTO QUALX
- +4 ; qualifier for Medicare Part ?
- IF Z="1C"
- Begin DoDot:1
- +5 ; 1500
- IF $GET(FORMTYPE)=2
- SET QUAL="MEDICARE PART B"
- +6 ; ub
- IF $GET(FORMTYPE)=3
- SET QUAL="MEDICARE PART A"
- +7 QUIT
- End DoDot:1
- GOTO QUALX
- +8 ; qualifier for SSN
- IF Z=34
- SET Z="SY"
- +9 SET IEN=+$ORDER(^IBE(355.97,"C",Z,""))
- IF 'IEN
- GOTO QUALX
- +10 SET QUAL=$PIECE($GET(^IBE(355.97,IEN,0)),U,1)
- QUALX ;
- +1 QUIT QUAL
- +2 ;
- SECID(Z,IBQUIT) ; Display secondary ID and qualifier information
- +1 ; Z is the type of IDs passed in; either BILLING PRV or LAB/FAC
- +2 ; IBQUIT is returned if passed by reference
- +3 NEW SEQ,ZI,ZN,PSIN,DATA,QUALNM,IDNUM,NODATA
- +4 SET IBQUIT=0
- SET NODATA=1
- +5 FOR SEQ="P","S","T"
- Begin DoDot:1
- +6 ;
- +7 ; current ins only for billing provider secondary IDs
- +8 IF Z="BILLING PRV"
- IF SEQ'=$$COB^IBCEF(IBIFN)
- QUIT
- +9 SET ZI=""
- +10 FOR
- SET ZI=$ORDER(IBX(Z,SEQ,ZI))
- if ZI=""
- QUIT
- Begin DoDot:2
- +11 SET ZN=0
- +12 FOR
- SET ZN=$ORDER(IBX(Z,SEQ,ZI,ZN))
- if 'ZN
- QUIT
- Begin DoDot:3
- +13 ; start at 0 to skip primary IDs
- SET PSIN=0
- +14 ;*432/TAZ - Changed Q:PSIN="" to Q:'PSIN to prevent "CONTACTS" node from printing as secondary ID
- +15 FOR
- SET PSIN=$ORDER(IBID(Z,IBIFN,ZI,ZN,PSIN))
- if 'PSIN
- QUIT
- Begin DoDot:4
- +16 SET DATA=$GET(IBID(Z,IBIFN,ZI,ZN,PSIN))
- +17 SET QUALNM=$$QUAL($PIECE(DATA,U,1),$$FT^IBCEF(IBIFN))
- +18 SET IDNUM=$PIECE(DATA,U,2)
- +19 IF ($Y+5)>IOSL
- SET IBQUIT=$$NOMORE^IBCEF74()
- if IBQUIT
- QUIT
- +20 SET NODATA=0
- +21 WRITE !?8,"(",SEQ,") ",QUALNM,?40,IDNUM
- +22 IF Z="LAB/FAC"
- IF $DATA(^DGCR(399,IBIFN,"I2"))
- IF SEQ=$$COB^IBCEF(IBIFN)
- WRITE ?54,"<<<Current Ins"
- +23 IF Z="BILLING PRV"
- IF PSIN=1
- WRITE ?54,"<<<System Generated ID"
- +24 QUIT
- End DoDot:4
- if IBQUIT
- QUIT
- +25 QUIT
- End DoDot:3
- if IBQUIT
- QUIT
- +26 QUIT
- End DoDot:2
- if IBQUIT
- QUIT
- +27 QUIT
- End DoDot:1
- if IBQUIT
- QUIT
- +28 IF NODATA
- IF 'IBQUIT
- WRITE !?8,"(-) None Found"
- SECIDX ;
- +1 QUIT
- +2 ;