IBRBUL ;ALB/CJM - MEANS TEST HOLD CHARGE BULLETIN ;02-MAR-92
;;2.0;INTEGRATED BILLING;**70,95,121,153,195,347,452,516,647**;21-MAR-94;Build 10
;;Per VA Directive 6402, this routine should not be modified.
; This bulletin is sent even if the local site has chosen not to hold
; Means Test charges. In that case, IBHOLDP should be set = 0.
; requires: IBDD() = internal node in patient file of valid ins.
; DUZ
; X = 0 node of IB BILLING ACTION
; IBHOLDP = 1 if charge on hold, = 0 otherwise
; IBSEQNO = 1 if the charges are new, 3 if updated
BULL N XMSUB,XMY,XMDUZ,XMTEXT,IBX,IBDUZ,IBNAME,IBPID,IBBID,IBAGE,DFN
S IBX=X,IBDUZ=DUZ
K ^TMP($J,"IBRBUL")
D PAT,HDR,PATLINE,CHRG,INS,BUF,MAIL
K ^TMP($J,"IBRBUL")
Q
MAIL ; Transmit mail
N IBGRP S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="^TMP($J,""IBRBUL"","
K XMY
S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),U,11),0)),U)
I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
D ^XMD
Q
;Add a line to the text array
ADDLN(IBTXT) N IBC
S IBC=$O(^TMP($J,"IBRBUL",""),-1)+1
S ^TMP($J,"IBRBUL",IBC)=$G(IBTXT," ")
Q
;
MAILTST ; for testing
;N IBC
;W !,XMSUB
;F IBC=1:1 Q:'$D(^TMP($J,"IBRBUL",IBC)) W !,^(IBC)
Q
HDR ; formated for held charges
N IBW,IBU,IBV,SL
S IBW=$S('IBHOLDP:"NOT ON HOLD",1:"ON HOLD")
S IBU=$S(IBSEQNO=1:"NEW ",IBSEQNO=3:"UPDATED ",1:"")
S IBV=$S(+$O(IBDD(0)):"active",1:"may have")
; if the parent event should have the soft-link that is needed to find
; the division
S SL=$P(X,"^",16) S:SL SL=$G(^IB(SL,0)) S:'SL SL=X S SL=$P(SL,"^",4)
S XMSUB="PATIENT CHRG W/INS"_"-"_$E($$DIV(SL),1,11)
D ADDLN("The following patient has "_IBU_"charges "_IBW_" and "_IBV_" insurance.")
D ADDLN("You need to immediately process the charges to the insurance company.")
I +$$BUFFER^IBCNBU1(+$P(X,"^",2)) D
. D ADDLN()
. D ADDLN("This patient has entries in the Insurance Buffer that should be processed")
. D ADDLN("before the charges.")
Q
PAT ; gets patient demographic data
N VAERR,VADM,X,VA
S DFN=+$P(IBX,"^",2) D DEM^VADPT I VAERR K VADM
S IBNAME=$$PR($G(VADM(1)),26),IBAGE=$$PR($G(VADM(4)),3),IBPID=$G(VA("PID")),IBBID=$G(VA("BID"))
Q
PATLINE ; sets up lines with patient data
D ADDLN(),ADDLN("Name: "_IBNAME_" Age : "_IBAGE_" Pt. ID: "_IBPID)
Q
CHRG ; gets charge data and sets up charge lines
N TP,FR,TO,IBND1,IBRXN,IBRX,IBRDT,IBRF,IENS,IBECME
S IBND1=$G(^IB(+$G(IBN),1)),(IBRX,IBRXN,IBRF,IBRDT,IBECME)=0
S FR=$$DAT1^IBOUTL($S($P(IBX,"^",14)'="":($P(IBX,"^",14)),1:$P(IBND1,"^",2)))
S TO=$$DAT1^IBOUTL($S($P(IBX,"^",15)'="":($P(IBX,"^",15)),1:$P(IBND1,"^",2)))
;
; Rx Info
I $P(IBX,"^",4)["52:" D
. S IBRXN=+$P($P(IBX,"^",4),":",2) ; Rx ien
. S IBRX=$P($P(IBX,"^",8),"-") ; external Rx#
. S IBRF=+$P($P(IBX,"^",4),":",3) ; fill# or 0 for original fill
. S IBECME=$P($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6) ; ecme# DBIA 4719
. I IBRF S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IENS,52,.01) ; refill date
. I 'IBRF S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(IENS,22) ; orig fill date
. Q
;
S TP=$P(IBX,"^",3) S:TP TP=$P($G(^IBE(350.1,TP,0)),"^",3) S:TP TP=$P($$CATN^PRCAFN(TP),"^",2)
D ADDLN("Type: "_$$PR(TP,28)_" Amount : $"_+$P(IBX,"^",7))
D ADDLN("From: "_$$PR(FR,28)_" To : "_TO)
I IBRXN D ADDLN("Rx #: "_$$PR(IBRX_$S(IBRF'="":" ("_IBRF_")",1:""),28)_" Fill Dt: "_$$DAT1^IBOUTL(IBRDT)_" Rls Dt: "_TO)
I IBECME D ADDLN("ECME: "_IBECME)
Q
INS ; gets insurance data and sets up insurance lines
N I,CO,P,G,GNB,W,E,Y,C,COV,COVD,COVFN,LEDT,LIM,PLN,X1,X2,Z0,IBCNT,P1,P2,P3,P4
;S IBDTIN=$P(IBX,"^",14)
D ADDLN(),ADDLN("INSURANCE INFORMATION:")
S I="" F S I=$O(IBDD(I)) Q:'I D
.S LIM=0
.S CO=$P(IBDD(I),"^",1),CO=$P(^DIC(36,CO,0),"^",1),CO=$$PR(CO,25)
.S P=$$PR($P(IBDD(I),"^",2),21)
.S P1=2.312,P2=6,P3=$P($G(IBDD(I)),"^",6) S P4=$$EXPAND^IBTRE(P1,P2,P3) S W=$$PR(P4,25)
.S Y=$P(IBDD(I),"^",4) D:Y DD^%DT S E=Y
.S G=$$PR($P(IBDD(I),"^",15),25)
.S GNB=$P(IBDD(I),"^",3)
.S PLN=$P(IBDD(I),"^",18)
.D ADDLN(),ADDLN("Company: "_CO_" Policy#: "_P)
.D ADDLN("Whose : "_W_" Expires: "_E)
.D ADDLN("Group : "_G_" Group# : "_GNB)
.Q:'PLN
.D ADDLN(" Plan Coverage Effective Date Covered? Limit Comments")
.D ADDLN(" ------------- -------------- -------- --------------")
.F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM S COV=$P($G(^(LIM,0)),U),IBCNT=0,LEDT="" F S LEDT=$O(^IBA(355.32,"APCD",PLN,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
..S COVFN=+$O(^IBA(355.32,"APCD",PLN,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
..I COVD="" D ADDLN(" "_$$PR(COV,32)_"BY DEFAULT") Q
..S IBCNT=IBCNT+1
..S X1=" "_$S(IBCNT=1:COV,1:"") ;Don't duplicate category
..S X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($P(LEDT,"-",2)),16)_$$PR($S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES",$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
..I '$O(^IBA(355.32,COVFN,2,0)) D ADDLN(X2) Q
..S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 D ADDLN($S(Z0=1:X2_$G(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR("",48)_$G(^IBA(355.32,COVFN,2,Z0,0))))
Q
PR(STR,LEN) ; pad right
N B S STR=$E(STR,1,LEN),$P(B," ",LEN-$L(STR))=" "
Q STR_$G(B)
DIV(SL) ; returns the division with the softlink as input
N IBDIV,IBWARD,IBFILE,IBIEN
S:SL[";" SL=$P(SL,";",1)
S IBFILE=$P(SL,":",1),IBIEN=$P(SL,":",2)
S IBDIV=""
I IBFILE=409.68,IBIEN S IBDIV=$$SCE^IBSDU(IBIEN,11)
I IBFILE=44,IBIEN S IBDIV=$P($G(^SC(IBIEN,0)),"^",15)
I IBFILE=405,IBIEN S IBWARD=$P($G(^DGPM(IBIEN,0)),"^",6) I IBWARD S IBDIV=$P($G(^DIC(42,IBWARD,0)),"^",11)
I IBDIV S IBDIV=$P($G(^DG(40.8,IBDIV,0)),"^",1)
I IBDIV="" S IBDIV="DIV UNKNWN"
Q IBDIV
;
BUF ; gets insurance buffer entries and sets up lines to add to bulletin
N DFN,IBBDA,IBB40,IBB60,IBX1,IBX2 S DFN=$P(IBX,U,2) Q:'DFN
I '$$BUFFER^IBCNBU1(DFN) Q
;
D ADDLN()
D ADDLN("INSURANCE BUFFER:")
S IBBDA=0 F S IBBDA=$O(^IBA(355.33,"C",DFN,IBBDA)) Q:'IBBDA D
. ;IB*2.0*516/TAZ - Use HIPAA compliant fields
. S IBB40=$G(^IBA(355.33,IBBDA,40)),IBB60=$G(^IBA(355.33,IBBDA,60))
. ;
. D ADDLN()
. ;S IBX1=$P($G(^IBA(355.33,IBBDA,20)),U,1),IBX2=$P(IBB60,U,4)
. S IBX1=$P($G(^IBA(355.33,IBBDA,20)),U,1)
. ;D ADDLN("Company: "_$$PR(IBX1,25)_"Policy#: "_$$PR(IBX2,21))
. D ADDLN("Company: "_$$PR(IBX1,25)_"Policy#: "_$$PR($$GET1^DIQ(355.33,IBBDA_",",90.03),21))
. S IBX1=$$EXPAND^IBTRE(355.33,60.05,$P(IBB60,U,5)),IBX2=$$FMTE^XLFDT($P(IBB60,U,3))
. D ADDLN("Whose : "_$$PR(IBX1,25)_"Expires: "_IBX2)
. ;S IBX1=$P(IBB40,U,2),IBX2=$P(IBB40,U,3)
. ;D ADDLN("Group : "_$$PR(IBX1,25)_"Group# : "_IBX2)
. D ADDLN("Group : "_$$PR($$GET1^DIQ(355.33,IBBDA_",",90.01),25)_"Group# : "_$$GET1^DIQ(355.33,IBBDA_",",90.02))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRBUL 6808 printed Dec 13, 2024@02:26:41 Page 2
IBRBUL ;ALB/CJM - MEANS TEST HOLD CHARGE BULLETIN ;02-MAR-92
+1 ;;2.0;INTEGRATED BILLING;**70,95,121,153,195,347,452,516,647**;21-MAR-94;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ; This bulletin is sent even if the local site has chosen not to hold
+4 ; Means Test charges. In that case, IBHOLDP should be set = 0.
+5 ; requires: IBDD() = internal node in patient file of valid ins.
+6 ; DUZ
+7 ; X = 0 node of IB BILLING ACTION
+8 ; IBHOLDP = 1 if charge on hold, = 0 otherwise
+9 ; IBSEQNO = 1 if the charges are new, 3 if updated
BULL NEW XMSUB,XMY,XMDUZ,XMTEXT,IBX,IBDUZ,IBNAME,IBPID,IBBID,IBAGE,DFN
+1 SET IBX=X
SET IBDUZ=DUZ
+2 KILL ^TMP($JOB,"IBRBUL")
+3 DO PAT
DO HDR
DO PATLINE
DO CHRG
DO INS
DO BUF
DO MAIL
+4 KILL ^TMP($JOB,"IBRBUL")
+5 QUIT
MAIL ; Transmit mail
+1 NEW IBGRP
SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="^TMP($J,""IBRBUL"","
+2 KILL XMY
+3 SET IBGRP=$PIECE($GET(^XMB(3.8,+$PIECE($GET(^IBE(350.9,1,0)),U,11),0)),U)
+4 IF IBGRP]""
SET XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
+5 DO ^XMD
+6 QUIT
+7 ;Add a line to the text array
ADDLN(IBTXT) NEW IBC
+1 SET IBC=$ORDER(^TMP($JOB,"IBRBUL",""),-1)+1
+2 SET ^TMP($JOB,"IBRBUL",IBC)=$GET(IBTXT," ")
+3 QUIT
+4 ;
MAILTST ; for testing
+1 ;N IBC
+2 ;W !,XMSUB
+3 ;F IBC=1:1 Q:'$D(^TMP($J,"IBRBUL",IBC)) W !,^(IBC)
+4 QUIT
HDR ; formated for held charges
+1 NEW IBW,IBU,IBV,SL
+2 SET IBW=$SELECT('IBHOLDP:"NOT ON HOLD",1:"ON HOLD")
+3 SET IBU=$SELECT(IBSEQNO=1:"NEW ",IBSEQNO=3:"UPDATED ",1:"")
+4 SET IBV=$SELECT(+$ORDER(IBDD(0)):"active",1:"may have")
+5 ; if the parent event should have the soft-link that is needed to find
+6 ; the division
+7 SET SL=$PIECE(X,"^",16)
if SL
SET SL=$GET(^IB(SL,0))
if 'SL
SET SL=X
SET SL=$PIECE(SL,"^",4)
+8 SET XMSUB="PATIENT CHRG W/INS"_"-"_$EXTRACT($$DIV(SL),1,11)
+9 DO ADDLN("The following patient has "_IBU_"charges "_IBW_" and "_IBV_" insurance.")
+10 DO ADDLN("You need to immediately process the charges to the insurance company.")
+11 IF +$$BUFFER^IBCNBU1(+$PIECE(X,"^",2))
Begin DoDot:1
+12 DO ADDLN()
+13 DO ADDLN("This patient has entries in the Insurance Buffer that should be processed")
+14 DO ADDLN("before the charges.")
End DoDot:1
+15 QUIT
PAT ; gets patient demographic data
+1 NEW VAERR,VADM,X,VA
+2 SET DFN=+$PIECE(IBX,"^",2)
DO DEM^VADPT
IF VAERR
KILL VADM
+3 SET IBNAME=$$PR($GET(VADM(1)),26)
SET IBAGE=$$PR($GET(VADM(4)),3)
SET IBPID=$GET(VA("PID"))
SET IBBID=$GET(VA("BID"))
+4 QUIT
PATLINE ; sets up lines with patient data
+1 DO ADDLN()
DO ADDLN("Name: "_IBNAME_" Age : "_IBAGE_" Pt. ID: "_IBPID)
+2 QUIT
CHRG ; gets charge data and sets up charge lines
+1 NEW TP,FR,TO,IBND1,IBRXN,IBRX,IBRDT,IBRF,IENS,IBECME
+2 SET IBND1=$GET(^IB(+$GET(IBN),1))
SET (IBRX,IBRXN,IBRF,IBRDT,IBECME)=0
+3 SET FR=$$DAT1^IBOUTL($SELECT($PIECE(IBX,"^",14)'="":($PIECE(IBX,"^",14)),1:$PIECE(IBND1,"^",2)))
+4 SET TO=$$DAT1^IBOUTL($SELECT($PIECE(IBX,"^",15)'="":($PIECE(IBX,"^",15)),1:$PIECE(IBND1,"^",2)))
+5 ;
+6 ; Rx Info
+7 IF $PIECE(IBX,"^",4)["52:"
Begin DoDot:1
+8 ; Rx ien
SET IBRXN=+$PIECE($PIECE(IBX,"^",4),":",2)
+9 ; external Rx#
SET IBRX=$PIECE($PIECE(IBX,"^",8),"-")
+10 ; fill# or 0 for original fill
SET IBRF=+$PIECE($PIECE(IBX,"^",4),":",3)
+11 ; ecme# DBIA 4719
SET IBECME=$PIECE($$CLAIM^BPSBUTL(IBRXN,IBRF),U,6)
+12 ; refill date
IF IBRF
SET IENS=+IBRF
SET IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IENS,52,.01)
+13 ; orig fill date
IF 'IBRF
SET IENS=+IBRXN
SET IBRDT=$$FILE^IBRXUTL(IENS,22)
+14 QUIT
End DoDot:1
+15 ;
+16 SET TP=$PIECE(IBX,"^",3)
if TP
SET TP=$PIECE($GET(^IBE(350.1,TP,0)),"^",3)
if TP
SET TP=$PIECE($$CATN^PRCAFN(TP),"^",2)
+17 DO ADDLN("Type: "_$$PR(TP,28)_" Amount : $"_+$PIECE(IBX,"^",7))
+18 DO ADDLN("From: "_$$PR(FR,28)_" To : "_TO)
+19 IF IBRXN
DO ADDLN("Rx #: "_$$PR(IBRX_$SELECT(IBRF'="":" ("_IBRF_")",1:""),28)_" Fill Dt: "_$$DAT1^IBOUTL(IBRDT)_" Rls Dt: "_TO)
+20 IF IBECME
DO ADDLN("ECME: "_IBECME)
+21 QUIT
INS ; gets insurance data and sets up insurance lines
+1 NEW I,CO,P,G,GNB,W,E,Y,C,COV,COVD,COVFN,LEDT,LIM,PLN,X1,X2,Z0,IBCNT,P1,P2,P3,P4
+2 ;S IBDTIN=$P(IBX,"^",14)
+3 DO ADDLN()
DO ADDLN("INSURANCE INFORMATION:")
+4 SET I=""
FOR
SET I=$ORDER(IBDD(I))
if 'I
QUIT
Begin DoDot:1
+5 SET LIM=0
+6 SET CO=$PIECE(IBDD(I),"^",1)
SET CO=$PIECE(^DIC(36,CO,0),"^",1)
SET CO=$$PR(CO,25)
+7 SET P=$$PR($PIECE(IBDD(I),"^",2),21)
+8 SET P1=2.312
SET P2=6
SET P3=$PIECE($GET(IBDD(I)),"^",6)
SET P4=$$EXPAND^IBTRE(P1,P2,P3)
SET W=$$PR(P4,25)
+9 SET Y=$PIECE(IBDD(I),"^",4)
if Y
DO DD^%DT
SET E=Y
+10 SET G=$$PR($PIECE(IBDD(I),"^",15),25)
+11 SET GNB=$PIECE(IBDD(I),"^",3)
+12 SET PLN=$PIECE(IBDD(I),"^",18)
+13 DO ADDLN()
DO ADDLN("Company: "_CO_" Policy#: "_P)
+14 DO ADDLN("Whose : "_W_" Expires: "_E)
+15 DO ADDLN("Group : "_G_" Group# : "_GNB)
+16 if 'PLN
QUIT
+17 DO ADDLN(" Plan Coverage Effective Date Covered? Limit Comments")
+18 DO ADDLN(" ------------- -------------- -------- --------------")
+19 FOR
SET LIM=$ORDER(^IBE(355.31,LIM))
if 'LIM
QUIT
SET COV=$PIECE($GET(^(LIM,0)),U)
SET IBCNT=0
SET LEDT=""
FOR
SET LEDT=$ORDER(^IBA(355.32,"APCD",PLN,LIM,LEDT))
if $SELECT(LEDT=""
QUIT
Begin DoDot:2
+20 SET COVFN=+$ORDER(^IBA(355.32,"APCD",PLN,LIM,+LEDT,""))
SET COVD=$GET(^IBA(355.32,+COVFN,0))
+21 IF COVD=""
DO ADDLN(" "_$$PR(COV,32)_"BY DEFAULT")
QUIT
+22 SET IBCNT=IBCNT+1
+23 ;Don't duplicate category
SET X1=" "_$SELECT(IBCNT=1:COV,1:"")
+24 SET X2=$$PR(X1,18)_$$PR($$DAT1^IBOUTL($PIECE(LEDT,"-",2)),16)_$$PR($SELECT($PIECE(COVD,U,4):$SELECT($PIECE(COVD,U,4)<2:"YES",$PIECE(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO"),14)
+25 IF '$ORDER(^IBA(355.32,COVFN,2,0))
DO ADDLN(X2)
QUIT
+26 SET Z0=0
FOR
SET Z0=$ORDER(^IBA(355.32,COVFN,2,Z0))
if 'Z0
QUIT
DO ADDLN($SELECT(Z0=1:X2_$GET(^IBA(355.32,COVFN,2,Z0,0)),1:$$PR("",48)_$GET(^IBA(355.32,COVFN,2,Z0,0))))
End DoDot:2
if LEDT=""
QUIT
End DoDot:1
+27 QUIT
PR(STR,LEN) ; pad right
+1 NEW B
SET STR=$EXTRACT(STR,1,LEN)
SET $PIECE(B," ",LEN-$LENGTH(STR))=" "
+2 QUIT STR_$GET(B)
DIV(SL) ; returns the division with the softlink as input
+1 NEW IBDIV,IBWARD,IBFILE,IBIEN
+2 if SL[";"
SET SL=$PIECE(SL,";",1)
+3 SET IBFILE=$PIECE(SL,":",1)
SET IBIEN=$PIECE(SL,":",2)
+4 SET IBDIV=""
+5 IF IBFILE=409.68
IF IBIEN
SET IBDIV=$$SCE^IBSDU(IBIEN,11)
+6 IF IBFILE=44
IF IBIEN
SET IBDIV=$PIECE($GET(^SC(IBIEN,0)),"^",15)
+7 IF IBFILE=405
IF IBIEN
SET IBWARD=$PIECE($GET(^DGPM(IBIEN,0)),"^",6)
IF IBWARD
SET IBDIV=$PIECE($GET(^DIC(42,IBWARD,0)),"^",11)
+8 IF IBDIV
SET IBDIV=$PIECE($GET(^DG(40.8,IBDIV,0)),"^",1)
+9 IF IBDIV=""
SET IBDIV="DIV UNKNWN"
+10 QUIT IBDIV
+11 ;
BUF ; gets insurance buffer entries and sets up lines to add to bulletin
+1 NEW DFN,IBBDA,IBB40,IBB60,IBX1,IBX2
SET DFN=$PIECE(IBX,U,2)
if 'DFN
QUIT
+2 IF '$$BUFFER^IBCNBU1(DFN)
QUIT
+3 ;
+4 DO ADDLN()
+5 DO ADDLN("INSURANCE BUFFER:")
+6 SET IBBDA=0
FOR
SET IBBDA=$ORDER(^IBA(355.33,"C",DFN,IBBDA))
if 'IBBDA
QUIT
Begin DoDot:1
+7 ;IB*2.0*516/TAZ - Use HIPAA compliant fields
+8 SET IBB40=$GET(^IBA(355.33,IBBDA,40))
SET IBB60=$GET(^IBA(355.33,IBBDA,60))
+9 ;
+10 DO ADDLN()
+11 ;S IBX1=$P($G(^IBA(355.33,IBBDA,20)),U,1),IBX2=$P(IBB60,U,4)
+12 SET IBX1=$PIECE($GET(^IBA(355.33,IBBDA,20)),U,1)
+13 ;D ADDLN("Company: "_$$PR(IBX1,25)_"Policy#: "_$$PR(IBX2,21))
+14 DO ADDLN("Company: "_$$PR(IBX1,25)_"Policy#: "_$$PR($$GET1^DIQ(355.33,IBBDA_",",90.03),21))
+15 SET IBX1=$$EXPAND^IBTRE(355.33,60.05,$PIECE(IBB60,U,5))
SET IBX2=$$FMTE^XLFDT($PIECE(IBB60,U,3))
+16 DO ADDLN("Whose : "_$$PR(IBX1,25)_"Expires: "_IBX2)
+17 ;S IBX1=$P(IBB40,U,2),IBX2=$P(IBB40,U,3)
+18 ;D ADDLN("Group : "_$$PR(IBX1,25)_"Group# : "_IBX2)
+19 DO ADDLN("Group : "_$$PR($$GET1^DIQ(355.33,IBBDA_",",90.01),25)_"Group# : "_$$GET1^DIQ(355.33,IBBDA_",",90.02))
End DoDot:1
+20 QUIT
