IB20P202 ;WOIFO/AAT-GMT IB PART 3 POST-INSTALL ;24-OCT-02
;;2.0;INTEGRATED BILLING;**202**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
;
POST ;Post-Install procedure
;
K ^TMP($J,"IB20P202")
D PRNMSG ; Print message to the user
D RELALL ; Force conversion for all remaining patients
; Remove temporary global nodes
K ^XTMP("IB GMT CONVERSION")
K ^IB("AGMT")
K ^IB("AGMTP")
K ^TMP($J,"IB20P202")
Q
;
; Add the patient to the log message
ADDPAT(DFN,IBRES,IBNUM) N IBPT,IBSTA
S IBPT=$P($G(^DPT(DFN,0)),U) ;Patient's name
S IBSTA=$P($$LST^DGMTU(DFN),"^",3) ;Patient's Copayment Status
S IBSTA=$E(IBSTA,1,20),IBSTA=IBSTA_$J("",20-$L(IBSTA))
D ADDLN($J(IBNUM,3)_" "_IBPT_$J("",30-$L(IBPT))_" "_IBSTA_" "_(+IBRES)_" Charge"_$S(IBRES=1:"",1:"s"))
Q
;
;Add a line to the text array
ADDLN(IBTXT) N IBC
D MES^XPDUTL(" "_$G(IBTXT))
S IBC=$O(^TMP($J,"IB20P202",""),-1)+1
S ^TMP($J,"IB20P202",IBC)=$G(IBTXT," ")
Q
;
RELALL ;Release all remaining held charges off hold;
N DFN,IBRES,IBNUM,XMSUB,XMY,XMDUZ,XMTEXT,XMGROUP,DIFROM
D ADDLN("Geographic Means Test Clean-up, patch IB*2.0*202 post-install procedure.")
D ADDLN("During the GMT IB Clean-up procedure all Inpatient Means Test charges, placed")
D ADDLN("ON HOLD (RATE) since October 1, 2002, will be released and passed to the")
D ADDLN("Accounts Receivable package.")
D ADDLN("For patients with 'GMT COPAY REQUIRED' status charges will be recalculated.")
D ADDLN("Process started on "_$$NOW())
D ADDLN()
D ADDLN("Searching and processing patients, who did not pass the GMT conversion...")
D ADDLN()
S IBNUM=0
S DFN=0 F S DFN=$O(^IB("AGMTP",DFN)) Q:'DFN D
. S IBRES=$$RELHOLD(DFN)
. S IBNUM=IBNUM+1
. D ADDPAT(DFN,IBRES,IBNUM)
I IBNUM=0 D ADDLN("none found.")
I $D(^IB("AC",20)) D FORCEREL ; Force releasing of hold charges on hold (rate)
D ADDLN()
D ADDLN("Process finished at "_$$NOW())
D ADDLN()
I $D(^IB("AC",20)) D
. D ADDLN("Some charges still remain on hold (rate), they may be not related to GMT.")
. D ADDLN("Use 'List Charges Awaiting New Copay Rate' menu option to make sure, that ")
. D ADDLN("there is no GMT-related charges, placed on hold, because of unknown rate.")
I IBNUM>0 D ADDLN(),ADDLN("Use the 'Means Test Single Patient Billing Profile' report to review charges.")
;
; Send log message to IB MEANS TEST mail group.
S XMSUB="GEOGRAPHIC MEANS TEST CLEAN-UP PROCEDURE"
S XMDUZ="PATCH IB*2.0*202 POST-INIT"
S XMGROUP=$$GET1^DIQ(350.9,"1,",.11) ; Means Test billing Group
S XMY(DUZ)="" ; Send the message to the user (at least)
I XMGROUP'="" S XMY("G."_XMGROUP)=""
S XMTEXT="^TMP($J,""IB20P202"","
;
D ^XMD
Q
;
FORCEREL ; Force releasing remaining charges on hold (rate)
N IBACT,IBCNT
S IBCNT=0
S IBACT=0 F S IBACT=$O(^IB("AC",20,IBACT)) Q:'IBACT I $$RELCRG(IBACT) S IBCNT=IBCNT+1
I IBCNT D ADDLN(IBCNT_" inpatient charges were released off hold additionally.")
Q
;
;Perform "conversion" for the given patient
RELHOLD(DFN) N IBACT,IBDT,X,IBLIMIT,IBCNT
S DFN=+DFN
S IBLIMIT=$$PLUS($$GMTEFD^IBAGMT(),-30)
S IBCNT=0
;For each Patient's IB Action starting from the last, back to the GMT Effective Date:
S IBDT="" F S IBDT=$O(^IB("APTDT",DFN,IBDT),-1) Q:IBDT="" Q:IBDT<IBLIMIT D
. S IBACT="" F S IBACT=$O(^IB("APTDT",DFN,IBDT,IBACT),-1) Q:'IBACT S IBCNT=IBCNT+$$RELCRG(IBACT)
K ^IB("AGMTP",DFN) ; Remove the flag
Q IBCNT
;
;
; Release/recalculate the single charge
; Also adjust MT Billing Clock Data, if this is a Copay charge.
; Input: IB ACTION IEN
; Output: 1 - Processed, 0 - Charge does not need to be processed (or error)
RELCRG(IBACT) N DFN,IBZ,IBSTA,IBDT,IBCRG,IBNOS,IBSEQNO,IBDUZ,IBFDA,IBGMT,Y,IBCLK,IB90D,IBCLKZ,IBAMT,IBATYP
S IBZ=$G(^IB(IBACT,0)) Q:IBZ="" 0 ;Corrupted cross-reference
S DFN=$P(IBZ,U,2)
S IBSTA=$P(IBZ,U,5) I IBSTA'=20,IBSTA'=1 Q 0 ;Not a 'HOLD-RATE' and not an 'INCOMPLETE'
S IBATYP=+$P(IBZ,U,3) ; IB Action Type
S IBDT=$P(IBZ,U,14) ; Date Billed From
I IBDT<$$GMTEFD^IBAGMT() Q 0 ;Never touch charges 'billed from' before the GMT Effective Date
I '$$ISGMTTYP^IBAGMT(IBATYP) Q 0 ;Not a MT Inpatient charge
S X="RCERR^IB20P202",@^%ZOSF("TRAP")
S IBCRG=$P(IBZ,U,7) ;Charge Amount
S IBGMT=$$ISGMTPT^IBAGMT(DFN,IBDT) ; GMT Status for the patient
;Recalculate the charge
I IBGMT>0,'$P(^IB(IBACT,0),U,21) D ;If the patient has GMT Copayment Status
. S $P(^IB(IBACT,0),U,7)=$$REDUCE^IBAGMT(IBCRG) ;Reduce the amount to 20%
. S $P(^IB(IBACT,0),U,21)=1 ;Mark the charge as GMT RELATED
. Q:'$G(^IB("AGMT",IBACT)) ; Quit if that is not COPAY charge.
. ; The temporary node "AGMT" exists only for Inpatient Copay Charges.
. ; Adjusting MT Billing Clock Amount
. S IBCLK=+$P(^IB("AGMT",IBACT),U),IB90D=+$P(^(IBACT),U,2) Q:IB90D<1 Q:IB90D>4
. S IBCLKZ=$G(^IBE(351,IBCLK,0)) Q:IBCLKZ=""
. S IBAMT=+$P(IBCLKZ,"^",4+IB90D) S IBAMT=IBAMT-IBCRG+$$REDUCE^IBAGMT(IBCRG) S:IBAMT<0 IBAMT=0
. S $P(^IBE(351,IBCLK,0),U,4+IB90D)=IBAMT
K ^IB("AGMT",IBACT) ; Remove temporary node
; Now pass the held charge to the AR package (Incomplete charges will not be released)
I IBSTA'=1 S IBNOS=IBACT,IBSEQNO=$P($G(^IBE(350.1,IBATYP,0)),U,5) S:IBSEQNO="" IBSEQNO=1 S IBDUZ=DUZ D ^IBR I Y<0 D ERRMSG(IBACT,$P(Y,U,2,99))
I IBGMT'>0,IBSTA=1 Q 0 ; Incomplete charges for non-GMT patients
Q 1
;
RCERR N IBERR ;Error trapping for RELCRG
S IBERR=$$EC^%ZOSV
D ^%ZTER
D ERRMSG(IBACT,"Program Error "_IBERR)
Q 0
;
PLUS(IBDT,IBDAYS) N X,X1,X2,%H
S X1=IBDT,X2=IBDAYS
D C^%DTC
Q X
;
; Send error message to IB MEANS TEST group.
; "Please review the IB ACTION"
ERRMSG(IBACT,IBERR) N IBTXT,XMSUB,XMY,XMDUZ,XMTEXT,XMGROUP,DIFROM,IBGRP,IBI,DFN,IBPT,IBZ,IBC,IBDT,IBATYP
S XMSUB="IB GMT CLEAN-UP ERROR"
S XMDUZ="PATCH IB*2.0*202 POST-INIT"
S XMGROUP=$$GET1^DIQ(350.9,"1,",.11) ; Means Test billing Group
I XMGROUP="" S XMGROUP=DUZ ; No billing groups defined - send to the user
E S XMGROUP="G."_XMGROUP
S XMTEXT="IBTXT(",XMY(XMGROUP)=""
;
S IBZ=$G(^IB(IBACT,0))
S DFN=$P(IBZ,U,2),IBPT=$P($G(^DPT(DFN,0)),U)
S IBDT=$P(IBZ,U,14),IBATYP=+$P(IBZ,U,3)
S IBC=0
S IBC=IBC+1,IBTXT(IBC)="The Geographic Means Test software failed to process the Inpatient Means Test"
S IBC=IBC+1,IBTXT(IBC)="charge IEN "_IBACT_", placed on HOLD - RATE (or Incomplete) after the GMT Effective Date."
S IBC=IBC+1,IBTXT(IBC)=" "
S IBC=IBC+1,IBTXT(IBC)="The error occurred when trying to pass the charge to Accounts Receivable."
S IBC=IBC+1,IBTXT(IBC)="Please review the IB ACTION IEN "_IBACT_"."
S IBC=IBC+1,IBTXT(IBC)=" "
I $G(IBERR)'="" D
. S IBC=IBC+1,IBTXT(IBC)="Error code: "_IBERR
. S IBC=IBC+1,IBTXT(IBC)=" "
S IBC=IBC+1,IBTXT(IBC)="DIAGNOSTIC INFORMATION:"
S IBC=IBC+1,IBTXT(IBC)="Patient: "_IBPT
S IBC=IBC+1,IBTXT(IBC)="IB Action IEN: "_IBACT_", Date billed from: "_$$DAT($P(IBZ,"^",14))_", Date billed to: "_$$DAT($P(IBZ,"^",15))
S IBC=IBC+1,IBTXT(IBC)="IB Action Type: "_$E($$ACTNM^IBOUTL(IBATYP),1,30)
S IBC=IBC+1,IBTXT(IBC)="Total Charge Amount: "_$J($P(IBZ,U,7),"",2)_", The charge is "_$S($P(IBZ,U,21):"",1:"not ")_"marked as GMT Related."
I '$P(IBZ,U,21),IBDT'<$$GMTEFD^IBAGMT(),$$ISGMTTYP^IBAGMT(IBATYP),$$ISGMTPT^IBAGMT(DFN,IBDT)>0 D
. S IBC=IBC+1,IBTXT(IBC)="The amount must be decreased to 20% of initial value (GMT rate)."
. I '$P(IBZ,U,21) S IBC=IBC+1,IBTXT(IBC)="The charge is supposed to be GMT Related."
;
D ^XMD
Q
;
;
DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
I 'IBDT Q ""
Q $$FMTE^XLFDT(IBDT,"2MZ")
;
NOW() N %,%H,%I,X,Y
D NOW^%DTC S Y=%
D DD^%DT
S Y=$P(Y,"@")_" at "_$P(Y,"@",2)
Q Y
;
PRNMSG ;
N IBTXT
S IBTXT(1)=""
S IBTXT(2)=" Geographic Means Test, IB Part 3, Post-Install Starting"
S IBTXT(3)=""
S IBTXT(4)=" The procedure will find, adjust and bill all remaining"
S IBTXT(5)=" GMT-related IB charges, placed on hold since 10/1/2002,"
S IBTXT(6)=" because of unknown rate."
S IBTXT(7)=""
S IBTXT(8)=" The process will take some time ..."
S IBTXT(9)=""
D MES^XPDUTL(.IBTXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P202 8142 printed Apr 09, 2024@21:23:33 Page 2
IB20P202 ;WOIFO/AAT-GMT IB PART 3 POST-INSTALL ;24-OCT-02
+1 ;;2.0;INTEGRATED BILLING;**202**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ;Post-Install procedure
+1 ;
+2 KILL ^TMP($JOB,"IB20P202")
+3 ; Print message to the user
DO PRNMSG
+4 ; Force conversion for all remaining patients
DO RELALL
+5 ; Remove temporary global nodes
+6 KILL ^XTMP("IB GMT CONVERSION")
+7 KILL ^IB("AGMT")
+8 KILL ^IB("AGMTP")
+9 KILL ^TMP($JOB,"IB20P202")
+10 QUIT
+11 ;
+12 ; Add the patient to the log message
ADDPAT(DFN,IBRES,IBNUM) NEW IBPT,IBSTA
+1 ;Patient's name
SET IBPT=$PIECE($GET(^DPT(DFN,0)),U)
+2 ;Patient's Copayment Status
SET IBSTA=$PIECE($$LST^DGMTU(DFN),"^",3)
+3 SET IBSTA=$EXTRACT(IBSTA,1,20)
SET IBSTA=IBSTA_$JUSTIFY("",20-$LENGTH(IBSTA))
+4 DO ADDLN($JUSTIFY(IBNUM,3)_" "_IBPT_$JUSTIFY("",30-$LENGTH(IBPT))_" "_IBSTA_" "_(+IBRES)_" Charge"_$SELECT(IBRES=1:"",1:"s"))
+5 QUIT
+6 ;
+7 ;Add a line to the text array
ADDLN(IBTXT) NEW IBC
+1 DO MES^XPDUTL(" "_$GET(IBTXT))
+2 SET IBC=$ORDER(^TMP($JOB,"IB20P202",""),-1)+1
+3 SET ^TMP($JOB,"IB20P202",IBC)=$GET(IBTXT," ")
+4 QUIT
+5 ;
RELALL ;Release all remaining held charges off hold;
+1 NEW DFN,IBRES,IBNUM,XMSUB,XMY,XMDUZ,XMTEXT,XMGROUP,DIFROM
+2 DO ADDLN("Geographic Means Test Clean-up, patch IB*2.0*202 post-install procedure.")
+3 DO ADDLN("During the GMT IB Clean-up procedure all Inpatient Means Test charges, placed")
+4 DO ADDLN("ON HOLD (RATE) since October 1, 2002, will be released and passed to the")
+5 DO ADDLN("Accounts Receivable package.")
+6 DO ADDLN("For patients with 'GMT COPAY REQUIRED' status charges will be recalculated.")
+7 DO ADDLN("Process started on "_$$NOW())
+8 DO ADDLN()
+9 DO ADDLN("Searching and processing patients, who did not pass the GMT conversion...")
+10 DO ADDLN()
+11 SET IBNUM=0
+12 SET DFN=0
FOR
SET DFN=$ORDER(^IB("AGMTP",DFN))
if 'DFN
QUIT
Begin DoDot:1
+13 SET IBRES=$$RELHOLD(DFN)
+14 SET IBNUM=IBNUM+1
+15 DO ADDPAT(DFN,IBRES,IBNUM)
End DoDot:1
+16 IF IBNUM=0
DO ADDLN("none found.")
+17 ; Force releasing of hold charges on hold (rate)
IF $DATA(^IB("AC",20))
DO FORCEREL
+18 DO ADDLN()
+19 DO ADDLN("Process finished at "_$$NOW())
+20 DO ADDLN()
+21 IF $DATA(^IB("AC",20))
Begin DoDot:1
+22 DO ADDLN("Some charges still remain on hold (rate), they may be not related to GMT.")
+23 DO ADDLN("Use 'List Charges Awaiting New Copay Rate' menu option to make sure, that ")
+24 DO ADDLN("there is no GMT-related charges, placed on hold, because of unknown rate.")
End DoDot:1
+25 IF IBNUM>0
DO ADDLN()
DO ADDLN("Use the 'Means Test Single Patient Billing Profile' report to review charges.")
+26 ;
+27 ; Send log message to IB MEANS TEST mail group.
+28 SET XMSUB="GEOGRAPHIC MEANS TEST CLEAN-UP PROCEDURE"
+29 SET XMDUZ="PATCH IB*2.0*202 POST-INIT"
+30 ; Means Test billing Group
SET XMGROUP=$$GET1^DIQ(350.9,"1,",.11)
+31 ; Send the message to the user (at least)
SET XMY(DUZ)=""
+32 IF XMGROUP'=""
SET XMY("G."_XMGROUP)=""
+33 SET XMTEXT="^TMP($J,""IB20P202"","
+34 ;
+35 DO ^XMD
+36 QUIT
+37 ;
FORCEREL ; Force releasing remaining charges on hold (rate)
+1 NEW IBACT,IBCNT
+2 SET IBCNT=0
+3 SET IBACT=0
FOR
SET IBACT=$ORDER(^IB("AC",20,IBACT))
if 'IBACT
QUIT
IF $$RELCRG(IBACT)
SET IBCNT=IBCNT+1
+4 IF IBCNT
DO ADDLN(IBCNT_" inpatient charges were released off hold additionally.")
+5 QUIT
+6 ;
+7 ;Perform "conversion" for the given patient
RELHOLD(DFN) NEW IBACT,IBDT,X,IBLIMIT,IBCNT
+1 SET DFN=+DFN
+2 SET IBLIMIT=$$PLUS($$GMTEFD^IBAGMT(),-30)
+3 SET IBCNT=0
+4 ;For each Patient's IB Action starting from the last, back to the GMT Effective Date:
+5 SET IBDT=""
FOR
SET IBDT=$ORDER(^IB("APTDT",DFN,IBDT),-1)
if IBDT=""
QUIT
if IBDT<IBLIMIT
QUIT
Begin DoDot:1
+6 SET IBACT=""
FOR
SET IBACT=$ORDER(^IB("APTDT",DFN,IBDT,IBACT),-1)
if 'IBACT
QUIT
SET IBCNT=IBCNT+$$RELCRG(IBACT)
End DoDot:1
+7 ; Remove the flag
KILL ^IB("AGMTP",DFN)
+8 QUIT IBCNT
+9 ;
+10 ;
+11 ; Release/recalculate the single charge
+12 ; Also adjust MT Billing Clock Data, if this is a Copay charge.
+13 ; Input: IB ACTION IEN
+14 ; Output: 1 - Processed, 0 - Charge does not need to be processed (or error)
RELCRG(IBACT) NEW DFN,IBZ,IBSTA,IBDT,IBCRG,IBNOS,IBSEQNO,IBDUZ,IBFDA,IBGMT,Y,IBCLK,IB90D,IBCLKZ,IBAMT,IBATYP
+1 ;Corrupted cross-reference
SET IBZ=$GET(^IB(IBACT,0))
if IBZ=""
QUIT 0
+2 SET DFN=$PIECE(IBZ,U,2)
+3 ;Not a 'HOLD-RATE' and not an 'INCOMPLETE'
SET IBSTA=$PIECE(IBZ,U,5)
IF IBSTA'=20
IF IBSTA'=1
QUIT 0
+4 ; IB Action Type
SET IBATYP=+$PIECE(IBZ,U,3)
+5 ; Date Billed From
SET IBDT=$PIECE(IBZ,U,14)
+6 ;Never touch charges 'billed from' before the GMT Effective Date
IF IBDT<$$GMTEFD^IBAGMT()
QUIT 0
+7 ;Not a MT Inpatient charge
IF '$$ISGMTTYP^IBAGMT(IBATYP)
QUIT 0
+8 SET X="RCERR^IB20P202"
SET @^%ZOSF("TRAP")
+9 ;Charge Amount
SET IBCRG=$PIECE(IBZ,U,7)
+10 ; GMT Status for the patient
SET IBGMT=$$ISGMTPT^IBAGMT(DFN,IBDT)
+11 ;Recalculate the charge
+12 ;If the patient has GMT Copayment Status
IF IBGMT>0
IF '$PIECE(^IB(IBACT,0),U,21)
Begin DoDot:1
+13 ;Reduce the amount to 20%
SET $PIECE(^IB(IBACT,0),U,7)=$$REDUCE^IBAGMT(IBCRG)
+14 ;Mark the charge as GMT RELATED
SET $PIECE(^IB(IBACT,0),U,21)=1
+15 ; Quit if that is not COPAY charge.
if '$GET(^IB("AGMT",IBACT))
QUIT
+16 ; The temporary node "AGMT" exists only for Inpatient Copay Charges.
+17 ; Adjusting MT Billing Clock Amount
+18 SET IBCLK=+$PIECE(^IB("AGMT",IBACT),U)
SET IB90D=+$PIECE(^(IBACT),U,2)
if IB90D<1
QUIT
if IB90D>4
QUIT
+19 SET IBCLKZ=$GET(^IBE(351,IBCLK,0))
if IBCLKZ=""
QUIT
+20 SET IBAMT=+$PIECE(IBCLKZ,"^",4+IB90D)
SET IBAMT=IBAMT-IBCRG+$$REDUCE^IBAGMT(IBCRG)
if IBAMT<0
SET IBAMT=0
+21 SET $PIECE(^IBE(351,IBCLK,0),U,4+IB90D)=IBAMT
End DoDot:1
+22 ; Remove temporary node
KILL ^IB("AGMT",IBACT)
+23 ; Now pass the held charge to the AR package (Incomplete charges will not be released)
+24 IF IBSTA'=1
SET IBNOS=IBACT
SET IBSEQNO=$PIECE($GET(^IBE(350.1,IBATYP,0)),U,5)
if IBSEQNO=""
SET IBSEQNO=1
SET IBDUZ=DUZ
DO ^IBR
IF Y<0
DO ERRMSG(IBACT,$PIECE(Y,U,2,99))
+25 ; Incomplete charges for non-GMT patients
IF IBGMT'>0
IF IBSTA=1
QUIT 0
+26 QUIT 1
+27 ;
RCERR ;Error trapping for RELCRG
NEW IBERR
+1 SET IBERR=$$EC^%ZOSV
+2 DO ^%ZTER
+3 DO ERRMSG(IBACT,"Program Error "_IBERR)
+4 QUIT 0
+5 ;
PLUS(IBDT,IBDAYS) NEW X,X1,X2,%H
+1 SET X1=IBDT
SET X2=IBDAYS
+2 DO C^%DTC
+3 QUIT X
+4 ;
+5 ; Send error message to IB MEANS TEST group.
+6 ; "Please review the IB ACTION"
ERRMSG(IBACT,IBERR) NEW IBTXT,XMSUB,XMY,XMDUZ,XMTEXT,XMGROUP,DIFROM,IBGRP,IBI,DFN,IBPT,IBZ,IBC,IBDT,IBATYP
+1 SET XMSUB="IB GMT CLEAN-UP ERROR"
+2 SET XMDUZ="PATCH IB*2.0*202 POST-INIT"
+3 ; Means Test billing Group
SET XMGROUP=$$GET1^DIQ(350.9,"1,",.11)
+4 ; No billing groups defined - send to the user
IF XMGROUP=""
SET XMGROUP=DUZ
+5 IF '$TEST
SET XMGROUP="G."_XMGROUP
+6 SET XMTEXT="IBTXT("
SET XMY(XMGROUP)=""
+7 ;
+8 SET IBZ=$GET(^IB(IBACT,0))
+9 SET DFN=$PIECE(IBZ,U,2)
SET IBPT=$PIECE($GET(^DPT(DFN,0)),U)
+10 SET IBDT=$PIECE(IBZ,U,14)
SET IBATYP=+$PIECE(IBZ,U,3)
+11 SET IBC=0
+12 SET IBC=IBC+1
SET IBTXT(IBC)="The Geographic Means Test software failed to process the Inpatient Means Test"
+13 SET IBC=IBC+1
SET IBTXT(IBC)="charge IEN "_IBACT_", placed on HOLD - RATE (or Incomplete) after the GMT Effective Date."
+14 SET IBC=IBC+1
SET IBTXT(IBC)=" "
+15 SET IBC=IBC+1
SET IBTXT(IBC)="The error occurred when trying to pass the charge to Accounts Receivable."
+16 SET IBC=IBC+1
SET IBTXT(IBC)="Please review the IB ACTION IEN "_IBACT_"."
+17 SET IBC=IBC+1
SET IBTXT(IBC)=" "
+18 IF $GET(IBERR)'=""
Begin DoDot:1
+19 SET IBC=IBC+1
SET IBTXT(IBC)="Error code: "_IBERR
+20 SET IBC=IBC+1
SET IBTXT(IBC)=" "
End DoDot:1
+21 SET IBC=IBC+1
SET IBTXT(IBC)="DIAGNOSTIC INFORMATION:"
+22 SET IBC=IBC+1
SET IBTXT(IBC)="Patient: "_IBPT
+23 SET IBC=IBC+1
SET IBTXT(IBC)="IB Action IEN: "_IBACT_", Date billed from: "_$$DAT($PIECE(IBZ,"^",14))_", Date billed to: "_$$DAT($PIECE(IBZ,"^",15))
+24 SET IBC=IBC+1
SET IBTXT(IBC)="IB Action Type: "_$EXTRACT($$ACTNM^IBOUTL(IBATYP),1,30)
+25 SET IBC=IBC+1
SET IBTXT(IBC)="Total Charge Amount: "_$JUSTIFY($PIECE(IBZ,U,7),"",2)_", The charge is "_$SELECT($PIECE(IBZ,U,21):"",1:"not ")_"marked as GMT Related."
+26 IF '$PIECE(IBZ,U,21)
IF IBDT'<$$GMTEFD^IBAGMT()
IF $$ISGMTTYP^IBAGMT(IBATYP)
IF $$ISGMTPT^IBAGMT(DFN,IBDT)>0
Begin DoDot:1
+27 SET IBC=IBC+1
SET IBTXT(IBC)="The amount must be decreased to 20% of initial value (GMT rate)."
+28 IF '$PIECE(IBZ,U,21)
SET IBC=IBC+1
SET IBTXT(IBC)="The charge is supposed to be GMT Related."
End DoDot:1
+29 ;
+30 DO ^XMD
+31 QUIT
+32 ;
+33 ;
DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
+1 IF 'IBDT
QUIT ""
+2 QUIT $$FMTE^XLFDT(IBDT,"2MZ")
+3 ;
NOW() NEW %,%H,%I,X,Y
+1 DO NOW^%DTC
SET Y=%
+2 DO DD^%DT
+3 SET Y=$PIECE(Y,"@")_" at "_$PIECE(Y,"@",2)
+4 QUIT Y
+5 ;
PRNMSG ;
+1 NEW IBTXT
+2 SET IBTXT(1)=""
+3 SET IBTXT(2)=" Geographic Means Test, IB Part 3, Post-Install Starting"
+4 SET IBTXT(3)=""
+5 SET IBTXT(4)=" The procedure will find, adjust and bill all remaining"
+6 SET IBTXT(5)=" GMT-related IB charges, placed on hold since 10/1/2002,"
+7 SET IBTXT(6)=" because of unknown rate."
+8 SET IBTXT(7)=""
+9 SET IBTXT(8)=" The process will take some time ..."
+10 SET IBTXT(9)=""
+11 DO MES^XPDUTL(.IBTXT)
+12 QUIT
