IB20P669 ;/Albany - IB*2.0*669 POST INSTALL;03/10/20 2:10pm
;;2.0;Integrated Billing;**669**;Mar 20, 1995;Build 20
;Per VA Directive 6402, this routine should not be modified.
Q
;
POSTINIT ;Post Install for IB*2.0*669
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*669")
; Adding AR CATEGORIES and REVENUE SOURCE CODES
D QUEUEINT
;D INITUCDB ; Load initial data into Visit tracking DB
D NEWCREAS
D CANCLUC
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*669")
Q
;
QUEUEINT ; Run the UC Visit DB initialization in the background.
;
N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSK
;
; Set up the other TaskManager variables
S ZTRTN="INITUCDB^IB20P669"
S ZTDTH=$$NOW^XLFDT
S ZTDESC="IB*2.0*669 Initialize/Update File 351.82 - Urgent Care Visit Tracking DB"
S ZTIO=""
D ^%ZTLOAD ; Call TaskManager
D BMES^XPDUTL(" >> Task "_ZTSK_" started to update the Urgent Care Visit Tracking DB")
Q
;
INITUCDB ; Loop through the Copay file (350) to find any Urgent Care visits and update the UC database
;
N LOOP,FDA,FDAIEN,IBUCIEN1,IBUCIEN3,IBUCIEN4,IBQUIT,IBN,IBDATA,IBDFN,IBVST
N IBERR1,IBERR2,IBERR3,IBERR4,IBERR5,IBERR6
N IBVSTIEN,IBSTAT,IBBILL,IBBLST,IBREAS,IBLSDTA,IBSITE,IBCREAS
N X,Y,DIE,DA,DR,DLAYGO,DIC,DINUM
;
; Check to see if previously installed. If so, exit with message.
;I $O(^IBUC(351.82,0))]"" D Q
;. D BMES^XPDUTL(" >> Urgent Care Visit Tracking Database present. Initialization not tasked.")
;
;Looping through initially for adds
S IBUCIEN1=$O(^IBE(350.1,"B","CC URGENT CARE (OPT) NEW",""))
S IBUCIEN3=$O(^IBE(350.1,"B","CC URGENT CARE (OPT) CANCEL",""))
S IBUCIEN4=$O(^IBE(350.1,"B","DG FEE SERVICE (OPT) CANCEL",""))
S IBERR1=$O(^IBE(350.3,"B","UC - ENTERED IN ERROR","")) ;Skip
S IBERR2=$O(^IBE(350.3,"B","UC - DUPLICATE VISIT","")) ;Skip
S IBERR3=$O(^IBE(350.3,"B","ENTERED IN ERROR","")) ;Removed Entered in Error
S IBERR4=$O(^IBE(350.3,"B","CATASTROPHICALLY DISABLED","")) ;Free if <3 MISSION Act otherwise Visit Only No Copay
S IBERR5=$O(^IBE(350.3,"B","COMBAT VETERAN","")) ;Free if <3 MISSION Act otherwise Visit Only No Copay
S IBERR6=$O(^IBE(350.3,"B","PURPLE HEART CONFIRMED","")) ;Free if <3 MISSION Act otherwise Visit Only No Copay
D SITE^IBAUTL ;Defines variable IBSITE
;
S IBQUIT=0
;
;Initialize process tracking array in case initialization stops
N X,X2,X1,DT
S DT=$$DT^XLFDT,X1=DT,X2=30 D C^%DTC
S ^XTMP("IB20P669",0)=X_U_DT_U_"IB*2.0*669 Post install Urgent Care Visit Tracking Initialization"
;
F LOOP=IBUCIEN1,IBUCIEN3,IBUCIEN4 D Q:IBQUIT
. ;
. S IBN=0
. ;
. ;See if the initialization was halted. If so, restore loop variables to last entry processed.
. I $D(^XTMP("IB20P669",1)) S IBLSDTA=$G(^XTMP("IB20P669",1)),LOOP=$P(IBLSDTA,U),IBN=$P(IBLSDTA,U,2)
. ;
. F S IBN=$O(^IB("AE",LOOP,IBN)) Q:'IBN D
. . S IBDATA=$G(^IB(IBN,0)) ; Get the data
. . Q:IBDATA=""
. . S IBDFN=$P(IBDATA,U,2),IBVST=$P(IBDATA,U,14),IBVSTIEN=0
. . Q:IBVST<3190606 ;Do not count UC visits prior to the start of the UC program on 6/6/2019
. . S IBVSTIEN=$$DBCHK(IBDFN,IBVST)
. . S IBSTAT=4,IBREAS=5,IBBILL="@" ;init variables
. . S IBBLST=$P(IBDATA,U,5) ; Get the bill status
. . I (LOOP=IBUCIEN4),($P(IBDATA,U,7)'=30) Q ;Captures all of the DG FEE CANCEL entries from 6/6/2019 to install of IB*2.0*656
. . S IBCREAS=$P(IBDATA,U,10),IBBLST=$P(IBDATA,U,5)
. . I (IBBLST'=10),(LOOP=IBUCIEN1),+IBVSTIEN Q ;don't process if visit already in DB and adding a new paid visit
. . I IBBLST'=10 D
. . . S IBSTAT=1,IBREAS=""
. . . S IBBILL=$P(IBDATA,U,11) ;Billing Number
. . . I (IBBLST=8),(IBBILL="") S IBBILL="ON HOLD"
. . I IBBLST=10 D
. . . I (IBCREAS=IBERR3) S IBSTAT=3,IBREAS=3 ;Set Visit to Removed/Entered in Error
. . . ; If Cat Disabled, Purple Heart, or Combat Vet Cancel Reason is used, check for free visits. If any free visits available, set the visit to free
. . . I (IBCREAS=IBERR4)!(IBCREAS=IBERR5)!(IBCREAS=IBERR6),$$GETELGP^IBECEA36(IBDFN,IBVST) D
. . . . S IBNOVST=$$GETVST^IBECEA36(IBDFN,IBVST)
. . . . I $P(IBNOVST,U,2)<3 S IBSTAT=1,IBREAS=1 ;Potential Free visits
. . ;Add new entry to the tracking database
. . I (IBVSTIEN=0) D Q
. . . K FDA
. . . ;Store in array for adding to the file (#351.82)
. . . S FDA(351.82,"+1,",.01)=IBDFN ;Patient
. . . S FDA(351.82,"+1,",.02)=IBSITE ;Site
. . . S FDA(351.82,"+1,",.03)=IBVST ;Visit Date
. . . S FDA(351.82,"+1,",.04)=IBSTAT ;Status (2 - Billed or 3- Not Counted)
. . . S FDA(351.82,"+1,",.05)=IBBILL ;Status (2 - Billed or 3- Not Counted)
. . . S FDA(351.82,"+1,",1.01)=1 ;Status (2 - Billed or 3- Not Counted)
. . . S:$G(IBREAS)'="" FDA(351.82,"+1,",.06)=IBREAS ;Reason (Not counted)
. . . S FDA(351.82,"+1,",1.01)=1
. . . ;Add to the file.
. . . D UPDATE^DIE(,"FDA","FDAIEN")
. . . S FDAIEN=FDAIEN(1) K FDAIEN(1)
. . ;
. . ;Otherwise Taking a canceled visit and updating the reason, bill no, and status fields
. . I IBVSTIEN'=0 D
. . . ;S DLAYGO=351.82,DIC="^IBUC(351.82,",DIC(0)="L"
. . . ;I '+$G(IBVSTIEN) D FILE^DICN S LIEN=+IBVSTIEN K DIC,DINUM,DLAYGO
. . . S DR=".04////"_IBSTAT ; Visit Tracking Status
. . . S DR=DR_";.05////"_IBBILL ; Bill Number (should reset to NULL)
. . . S DR=DR_";.06////"_IBREAS ; Reason (should be UC-ENTERED IN ERROR or UC-Duplicate Event)
. . . S DR=DR_";1.01////1" ; Flag for multi-site transmission
. . . ;
. . . S DIE="^IBUC(351.82,",DA=IBVSTIEN
. . . D ^DIE
. . . K DR
. . ;Save the entry just processed
. . S ^XTMP("IB20P669",1)=LOOP_U_IBN
. . I $$S^%ZTLOAD() D Q
. . . ;
. . . N ZTRTN,ZTDTH,ZTDESC,ZTIO
. . . ;
. . . ;requeue for later
. . . S ZTRTN="INITUCDB^IB20P669"
. . . S ZTDTH=$$NOW^XLFDT+.01 ; reschedule for 1 hr after time process stopped
. . . S ZTDESC="IB*2.0*669 Initialize File 351.82 - Urgent Care Visit Tracking DB"
. . . S ZTIO=""
. . . D ^%ZTLOAD ; Call TaskManager
. . . S IBQUIT=1
K DR ;Clear update array before next use
Q
;
DBCHK(IBDFN,IBVDT) ; Check to see if the visit is already in the DB.
;
N IBLP,IBQUIT,IBDATA,IBDT
; Returns IBQUIT - the IEN of the Visit OR 0
;loop through the patient's visits to see if it has already been recorded.
S IBLP=0,IBQUIT=0
F S IBLP=$O(^IBUC(351.82,"B",IBDFN,IBLP)) Q:'IBLP D Q:IBQUIT
. S IBDATA=$G(^IBUC(351.82,IBLP,0))
. S IBDT=$P(IBDATA,U,3)
. ; quit if there is a visit already stored on that day.
. I IBDT=IBVDT S IBQUIT=IBLP
Q IBQUIT
;
CANCLUC ; Initialize the new CAN CANCEL URGENT CARE field (.04) in the IB CHARGE REMOVE REASON file (#350.3).
; Also inactivate UC-ENTERED IN ERROR AND UC-CHANGE IN ELIGIBILITY
; Also define the type of UC Visit Tracking DB (351.82) update process to follow when using the cancellation
;
N LOOP,LIEN,IBDATA,IBCCUC,IBINACT,IBNM,IBNOVST,IBUCDB
N X,Y,DIE,DA,DR,DTOUT,DATA
;
D MES^XPDUTL(" -> Update of the new IB CHARGE REMOVE REASON fields started.")
; Grab all of the entries to update
F LOOP=1:1:14 D
. ;Extract the new ACTION TYPE to be added.
. S IBDATA=$T(IBDDAT+LOOP)
. S IBDATA=$P(IBDATA,";;",2)
. S IBNM=$P(IBDATA,";",1),IBCCUC=$P(IBDATA,";",2),IBUCDB=$P(IBDATA,";",3),IBINACT=$P(IBDATA,";",4)
. S LIEN=$O(^IBE(350.3,"B",IBNM,"")) ; find CHARGE REMOVE REASON entry
. Q:LIEN=""
. ;
. ; File the update along with inactivate the ACTION TYPE
. S DR=".04///"_IBCCUC
. S DR=DR_";.05///"_IBUCDB
. S:IBINACT'="" DR=DR_";.06///"_IBINACT
. S DIE="^IBE(350.3,",DA=LIEN
. D ^DIE
. K DR ;Clear update array before next use
;
S DR=""
D MES^XPDUTL(" -> Update of IB CHARGE REMOVE REASON completed.")
Q
;
IBDDAT ; Cancellation reasons (350.3) to update
;;ENTERED IN ERROR;Y;1
;;PATIENT DECEASED;Y;2
;;CHANGE IN ELIGIBILITY;Y;3
;;RECD INPATIENT CARE;Y;2
;;PURPLE HEART CONFIRMED;N;3
;;BILLED AT HIGHER TIER RATE;Y;2
;;BILLED LTC CHARGE;Y;2
;;COMBAT VETERAN;N;3
;;CATASTROPHICALLY DISABLED;N;3
;;UC - ENTERED IN ERROR;Y;1;Y
;;UC - CHANGE IN ELIGIBILITY;Y;3;Y
;;UC - DUPLICATE VISIT;Y;4
;;UC - SEQUENCE UPDATE;Y;3
;;UC - PG6 REVIEWED;Y;3
;;END
;
NEWCREAS ; New Cancellation Reasons
N LOOP,LIEN,IBDATA,IBCNNM
N X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB
;
N CANIEN,UPDIEN,SVCIEN,CHGIEN
;
; Grab all of the entries to update
D MES^XPDUTL(" -> Adding new Cancellation Reason to the IB CHARGE REMOVE REASON file (350.3).")
S Y=-1
F LOOP=1:1 S IBDATA=$T(REASDAT+LOOP) Q:$P(IBDATA,";",3)="END" D
. S DR=""
. ;Extract the new ACTION TYPE to be added.
. ;Store in array for adding to the file (#350.1).
. Q:IBDATA="" ;go to next entry if Category is not to be updated.
. ;
. S IBCNNM=$P(IBDATA,";",3)
. S LIEN=$O(^IBE(350.3,"B",IBCNNM,""))
. ; File the update along with inactivate the ACTION TYPE
. S DLAYGO=350.3,DIC="^IBE(350.3,",DIC(0)="L",X=IBCNNM
. I '+LIEN D FILE^DICN S LIEN=+Y K DIC,DINUM,DLAYGO
. S DR=".02////"_$P(IBDATA,";",4) ; ABBREVIATION
. S DR=DR_";.03////"_$P(IBDATA,";",5) ; LIMIT
. ;
. S DIE="^IBE(350.3,",DA=LIEN
. D ^DIE
. ;<re-index new entry here>
. S DA=LIEN,DIK="^IBE(350.3," D IX^DIK
. K DR
Q
;
REASDAT ; Fee Service to inactivate
;;UC - PG6 REVIEWED;UCPG6;3
;;END
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P669 9419 printed Apr 09, 2024@21:24:34 Page 2
IB20P669 ;/Albany - IB*2.0*669 POST INSTALL;03/10/20 2:10pm
+1 ;;2.0;Integrated Billing;**669**;Mar 20, 1995;Build 20
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POSTINIT ;Post Install for IB*2.0*669
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*669")
+2 ; Adding AR CATEGORIES and REVENUE SOURCE CODES
+3 DO QUEUEINT
+4 ;D INITUCDB ; Load initial data into Visit tracking DB
+5 DO NEWCREAS
+6 DO CANCLUC
+7 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*669")
+8 QUIT
+9 ;
QUEUEINT ; Run the UC Visit DB initialization in the background.
+1 ;
+2 NEW ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSK
+3 ;
+4 ; Set up the other TaskManager variables
+5 SET ZTRTN="INITUCDB^IB20P669"
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTDESC="IB*2.0*669 Initialize/Update File 351.82 - Urgent Care Visit Tracking DB"
+8 SET ZTIO=""
+9 ; Call TaskManager
DO ^%ZTLOAD
+10 DO BMES^XPDUTL(" >> Task "_ZTSK_" started to update the Urgent Care Visit Tracking DB")
+11 QUIT
+12 ;
INITUCDB ; Loop through the Copay file (350) to find any Urgent Care visits and update the UC database
+1 ;
+2 NEW LOOP,FDA,FDAIEN,IBUCIEN1,IBUCIEN3,IBUCIEN4,IBQUIT,IBN,IBDATA,IBDFN,IBVST
+3 NEW IBERR1,IBERR2,IBERR3,IBERR4,IBERR5,IBERR6
+4 NEW IBVSTIEN,IBSTAT,IBBILL,IBBLST,IBREAS,IBLSDTA,IBSITE,IBCREAS
+5 NEW X,Y,DIE,DA,DR,DLAYGO,DIC,DINUM
+6 ;
+7 ; Check to see if previously installed. If so, exit with message.
+8 ;I $O(^IBUC(351.82,0))]"" D Q
+9 ;. D BMES^XPDUTL(" >> Urgent Care Visit Tracking Database present. Initialization not tasked.")
+10 ;
+11 ;Looping through initially for adds
+12 SET IBUCIEN1=$ORDER(^IBE(350.1,"B","CC URGENT CARE (OPT) NEW",""))
+13 SET IBUCIEN3=$ORDER(^IBE(350.1,"B","CC URGENT CARE (OPT) CANCEL",""))
+14 SET IBUCIEN4=$ORDER(^IBE(350.1,"B","DG FEE SERVICE (OPT) CANCEL",""))
+15 ;Skip
SET IBERR1=$ORDER(^IBE(350.3,"B","UC - ENTERED IN ERROR",""))
+16 ;Skip
SET IBERR2=$ORDER(^IBE(350.3,"B","UC - DUPLICATE VISIT",""))
+17 ;Removed Entered in Error
SET IBERR3=$ORDER(^IBE(350.3,"B","ENTERED IN ERROR",""))
+18 ;Free if <3 MISSION Act otherwise Visit Only No Copay
SET IBERR4=$ORDER(^IBE(350.3,"B","CATASTROPHICALLY DISABLED",""))
+19 ;Free if <3 MISSION Act otherwise Visit Only No Copay
SET IBERR5=$ORDER(^IBE(350.3,"B","COMBAT VETERAN",""))
+20 ;Free if <3 MISSION Act otherwise Visit Only No Copay
SET IBERR6=$ORDER(^IBE(350.3,"B","PURPLE HEART CONFIRMED",""))
+21 ;Defines variable IBSITE
DO SITE^IBAUTL
+22 ;
+23 SET IBQUIT=0
+24 ;
+25 ;Initialize process tracking array in case initialization stops
+26 NEW X,X2,X1,DT
+27 SET DT=$$DT^XLFDT
SET X1=DT
SET X2=30
DO C^%DTC
+28 SET ^XTMP("IB20P669",0)=X_U_DT_U_"IB*2.0*669 Post install Urgent Care Visit Tracking Initialization"
+29 ;
+30 FOR LOOP=IBUCIEN1,IBUCIEN3,IBUCIEN4
Begin DoDot:1
+31 ;
+32 SET IBN=0
+33 ;
+34 ;See if the initialization was halted. If so, restore loop variables to last entry processed.
+35 IF $DATA(^XTMP("IB20P669",1))
SET IBLSDTA=$GET(^XTMP("IB20P669",1))
SET LOOP=$PIECE(IBLSDTA,U)
SET IBN=$PIECE(IBLSDTA,U,2)
+36 ;
+37 FOR
SET IBN=$ORDER(^IB("AE",LOOP,IBN))
if 'IBN
QUIT
Begin DoDot:2
+38 ; Get the data
SET IBDATA=$GET(^IB(IBN,0))
+39 if IBDATA=""
QUIT
+40 SET IBDFN=$PIECE(IBDATA,U,2)
SET IBVST=$PIECE(IBDATA,U,14)
SET IBVSTIEN=0
+41 ;Do not count UC visits prior to the start of the UC program on 6/6/2019
if IBVST<3190606
QUIT
+42 SET IBVSTIEN=$$DBCHK(IBDFN,IBVST)
+43 ;init variables
SET IBSTAT=4
SET IBREAS=5
SET IBBILL="@"
+44 ; Get the bill status
SET IBBLST=$PIECE(IBDATA,U,5)
+45 ;Captures all of the DG FEE CANCEL entries from 6/6/2019 to install of IB*2.0*656
IF (LOOP=IBUCIEN4)
IF ($PIECE(IBDATA,U,7)'=30)
QUIT
+46 SET IBCREAS=$PIECE(IBDATA,U,10)
SET IBBLST=$PIECE(IBDATA,U,5)
+47 ;don't process if visit already in DB and adding a new paid visit
IF (IBBLST'=10)
IF (LOOP=IBUCIEN1)
IF +IBVSTIEN
QUIT
+48 IF IBBLST'=10
Begin DoDot:3
+49 SET IBSTAT=1
SET IBREAS=""
+50 ;Billing Number
SET IBBILL=$PIECE(IBDATA,U,11)
+51 IF (IBBLST=8)
IF (IBBILL="")
SET IBBILL="ON HOLD"
End DoDot:3
+52 IF IBBLST=10
Begin DoDot:3
+53 ;Set Visit to Removed/Entered in Error
IF (IBCREAS=IBERR3)
SET IBSTAT=3
SET IBREAS=3
+54 ; If Cat Disabled, Purple Heart, or Combat Vet Cancel Reason is used, check for free visits. If any free visits available, set the visit to free
+55 IF (IBCREAS=IBERR4)!(IBCREAS=IBERR5)!(IBCREAS=IBERR6)
IF $$GETELGP^IBECEA36(IBDFN,IBVST)
Begin DoDot:4
+56 SET IBNOVST=$$GETVST^IBECEA36(IBDFN,IBVST)
+57 ;Potential Free visits
IF $PIECE(IBNOVST,U,2)<3
SET IBSTAT=1
SET IBREAS=1
End DoDot:4
End DoDot:3
+58 ;Add new entry to the tracking database
+59 IF (IBVSTIEN=0)
Begin DoDot:3
+60 KILL FDA
+61 ;Store in array for adding to the file (#351.82)
+62 ;Patient
SET FDA(351.82,"+1,",.01)=IBDFN
+63 ;Site
SET FDA(351.82,"+1,",.02)=IBSITE
+64 ;Visit Date
SET FDA(351.82,"+1,",.03)=IBVST
+65 ;Status (2 - Billed or 3- Not Counted)
SET FDA(351.82,"+1,",.04)=IBSTAT
+66 ;Status (2 - Billed or 3- Not Counted)
SET FDA(351.82,"+1,",.05)=IBBILL
+67 ;Status (2 - Billed or 3- Not Counted)
SET FDA(351.82,"+1,",1.01)=1
+68 ;Reason (Not counted)
if $GET(IBREAS)'=""
SET FDA(351.82,"+1,",.06)=IBREAS
+69 SET FDA(351.82,"+1,",1.01)=1
+70 ;Add to the file.
+71 DO UPDATE^DIE(,"FDA","FDAIEN")
+72 SET FDAIEN=FDAIEN(1)
KILL FDAIEN(1)
End DoDot:3
QUIT
+73 ;
+74 ;Otherwise Taking a canceled visit and updating the reason, bill no, and status fields
+75 IF IBVSTIEN'=0
Begin DoDot:3
+76 ;S DLAYGO=351.82,DIC="^IBUC(351.82,",DIC(0)="L"
+77 ;I '+$G(IBVSTIEN) D FILE^DICN S LIEN=+IBVSTIEN K DIC,DINUM,DLAYGO
+78 ; Visit Tracking Status
SET DR=".04////"_IBSTAT
+79 ; Bill Number (should reset to NULL)
SET DR=DR_";.05////"_IBBILL
+80 ; Reason (should be UC-ENTERED IN ERROR or UC-Duplicate Event)
SET DR=DR_";.06////"_IBREAS
+81 ; Flag for multi-site transmission
SET DR=DR_";1.01////1"
+82 ;
+83 SET DIE="^IBUC(351.82,"
SET DA=IBVSTIEN
+84 DO ^DIE
+85 KILL DR
End DoDot:3
+86 ;Save the entry just processed
+87 SET ^XTMP("IB20P669",1)=LOOP_U_IBN
+88 IF $$S^%ZTLOAD()
Begin DoDot:3
+89 ;
+90 NEW ZTRTN,ZTDTH,ZTDESC,ZTIO
+91 ;
+92 ;requeue for later
+93 SET ZTRTN="INITUCDB^IB20P669"
+94 ; reschedule for 1 hr after time process stopped
SET ZTDTH=$$NOW^XLFDT+.01
+95 SET ZTDESC="IB*2.0*669 Initialize File 351.82 - Urgent Care Visit Tracking DB"
+96 SET ZTIO=""
+97 ; Call TaskManager
DO ^%ZTLOAD
+98 SET IBQUIT=1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
if IBQUIT
QUIT
+99 ;Clear update array before next use
KILL DR
+100 QUIT
+101 ;
DBCHK(IBDFN,IBVDT) ; Check to see if the visit is already in the DB.
+1 ;
+2 NEW IBLP,IBQUIT,IBDATA,IBDT
+3 ; Returns IBQUIT - the IEN of the Visit OR 0
+4 ;loop through the patient's visits to see if it has already been recorded.
+5 SET IBLP=0
SET IBQUIT=0
+6 FOR
SET IBLP=$ORDER(^IBUC(351.82,"B",IBDFN,IBLP))
if 'IBLP
QUIT
Begin DoDot:1
+7 SET IBDATA=$GET(^IBUC(351.82,IBLP,0))
+8 SET IBDT=$PIECE(IBDATA,U,3)
+9 ; quit if there is a visit already stored on that day.
+10 IF IBDT=IBVDT
SET IBQUIT=IBLP
End DoDot:1
if IBQUIT
QUIT
+11 QUIT IBQUIT
+12 ;
CANCLUC ; Initialize the new CAN CANCEL URGENT CARE field (.04) in the IB CHARGE REMOVE REASON file (#350.3).
+1 ; Also inactivate UC-ENTERED IN ERROR AND UC-CHANGE IN ELIGIBILITY
+2 ; Also define the type of UC Visit Tracking DB (351.82) update process to follow when using the cancellation
+3 ;
+4 NEW LOOP,LIEN,IBDATA,IBCCUC,IBINACT,IBNM,IBNOVST,IBUCDB
+5 NEW X,Y,DIE,DA,DR,DTOUT,DATA
+6 ;
+7 DO MES^XPDUTL(" -> Update of the new IB CHARGE REMOVE REASON fields started.")
+8 ; Grab all of the entries to update
+9 FOR LOOP=1:1:14
Begin DoDot:1
+10 ;Extract the new ACTION TYPE to be added.
+11 SET IBDATA=$TEXT(IBDDAT+LOOP)
+12 SET IBDATA=$PIECE(IBDATA,";;",2)
+13 SET IBNM=$PIECE(IBDATA,";",1)
SET IBCCUC=$PIECE(IBDATA,";",2)
SET IBUCDB=$PIECE(IBDATA,";",3)
SET IBINACT=$PIECE(IBDATA,";",4)
+14 ; find CHARGE REMOVE REASON entry
SET LIEN=$ORDER(^IBE(350.3,"B",IBNM,""))
+15 if LIEN=""
QUIT
+16 ;
+17 ; File the update along with inactivate the ACTION TYPE
+18 SET DR=".04///"_IBCCUC
+19 SET DR=DR_";.05///"_IBUCDB
+20 if IBINACT'=""
SET DR=DR_";.06///"_IBINACT
+21 SET DIE="^IBE(350.3,"
SET DA=LIEN
+22 DO ^DIE
+23 ;Clear update array before next use
KILL DR
End DoDot:1
+24 ;
+25 SET DR=""
+26 DO MES^XPDUTL(" -> Update of IB CHARGE REMOVE REASON completed.")
+27 QUIT
+28 ;
IBDDAT ; Cancellation reasons (350.3) to update
+1 ;;ENTERED IN ERROR;Y;1
+2 ;;PATIENT DECEASED;Y;2
+3 ;;CHANGE IN ELIGIBILITY;Y;3
+4 ;;RECD INPATIENT CARE;Y;2
+5 ;;PURPLE HEART CONFIRMED;N;3
+6 ;;BILLED AT HIGHER TIER RATE;Y;2
+7 ;;BILLED LTC CHARGE;Y;2
+8 ;;COMBAT VETERAN;N;3
+9 ;;CATASTROPHICALLY DISABLED;N;3
+10 ;;UC - ENTERED IN ERROR;Y;1;Y
+11 ;;UC - CHANGE IN ELIGIBILITY;Y;3;Y
+12 ;;UC - DUPLICATE VISIT;Y;4
+13 ;;UC - SEQUENCE UPDATE;Y;3
+14 ;;UC - PG6 REVIEWED;Y;3
+15 ;;END
+16 ;
NEWCREAS ; New Cancellation Reasons
+1 NEW LOOP,LIEN,IBDATA,IBCNNM
+2 NEW X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB
+3 ;
+4 NEW CANIEN,UPDIEN,SVCIEN,CHGIEN
+5 ;
+6 ; Grab all of the entries to update
+7 DO MES^XPDUTL(" -> Adding new Cancellation Reason to the IB CHARGE REMOVE REASON file (350.3).")
+8 SET Y=-1
+9 FOR LOOP=1:1
SET IBDATA=$TEXT(REASDAT+LOOP)
if $PIECE(IBDATA,";",3)="END"
QUIT
Begin DoDot:1
+10 SET DR=""
+11 ;Extract the new ACTION TYPE to be added.
+12 ;Store in array for adding to the file (#350.1).
+13 ;go to next entry if Category is not to be updated.
if IBDATA=""
QUIT
+14 ;
+15 SET IBCNNM=$PIECE(IBDATA,";",3)
+16 SET LIEN=$ORDER(^IBE(350.3,"B",IBCNNM,""))
+17 ; File the update along with inactivate the ACTION TYPE
+18 SET DLAYGO=350.3
SET DIC="^IBE(350.3,"
SET DIC(0)="L"
SET X=IBCNNM
+19 IF '+LIEN
DO FILE^DICN
SET LIEN=+Y
KILL DIC,DINUM,DLAYGO
+20 ; ABBREVIATION
SET DR=".02////"_$PIECE(IBDATA,";",4)
+21 ; LIMIT
SET DR=DR_";.03////"_$PIECE(IBDATA,";",5)
+22 ;
+23 SET DIE="^IBE(350.3,"
SET DA=LIEN
+24 DO ^DIE
+25 ;<re-index new entry here>
+26 SET DA=LIEN
SET DIK="^IBE(350.3,"
DO IX^DIK
+27 KILL DR
End DoDot:1
+28 QUIT
+29 ;
REASDAT ; Fee Service to inactivate
+1 ;;UC - PG6 REVIEWED;UCPG6;3
+2 ;;END
+3 QUIT
