IB20P663 ;/Albany - IB*2.0*663 POST INSTALL;07/25/19 2:10pm
;;2.0;Integrated Billing;**663**;Mar 20, 1995;Build 27
;Per VA Directive 6402, this routine should not be modified.
Q
;
POSTINIT ;Post Install for IB*2.0*663
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*663")
; Adding AR CATEGORIES and REVENUE SOURCE CODES
;D QUEUEINT
D INITUCDB ; Load initial data into Visit tracking DB
D NEWCREAS ; Add more UC reason codes.
D IBUPD ; Inactivate CHOICE and CC MTF Action Types
D TSKPUSH ; add the nightly task
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*663")
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^IB20P663"
S ZTDTH=$$NOW^XLFDT
S ZTDESC="IB*2.0*663 Initialize 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,IBUCIEN2,IBQUIT,IBN,IBDATA,IBDFN,IBVST,IBERR1,IBERR2
N IBVSTIEN,IBSTAT,IBBILL,IBBLST,IBREAS,IBLSDTA,IBSITE,IBUCIEN3,IBUCIEN4
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 IBUCIEN2=$O(^IBE(350.1,"B","DG FEE SERVICE (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",""))
S IBERR2=$O(^IBE(350.3,"B","UC - DUPLICATE VISIT",""))
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("IB20P663",0)=X_U_DT_U_"IB*2.0*663 Post install Urgent Care Visit Tracking Initialization"
;
F LOOP=IBUCIEN1,IBUCIEN2,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("IB20P663",1)) S IBLSDTA=$G(^XTMP("IB20P663",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)
. . I ((LOOP=IBUCIEN1)!(LOOP=IBUCIEN2)),+IBVSTIEN Q ;don't process if visit already in DB and adding a new paid visit
. . S IBSTAT=2,(IBBILL,IBREAS)="" ;init variables
. . S IBBLST=$P(IBDATA,U,5) ; Get the bill status
. . ;If Bill cancelled because UC entered in error, then set status to not counted, reason to Entered In Error.
. . I IBBLST=10 D
. . . I ($P(IBDATA,U,10)=IBERR1) S IBSTAT=3,IBREAS=3 ;UC-ENTERED IN ERROR
. . . I ($P(IBDATA,U,10)=IBERR2) S IBSTAT=3,IBREAS=4 ;UC-DUPLICATE EVENT
. . S:IBBLST'=10 IBBILL=$P(IBDATA,U,11) ;Billing Number
. . I (IBBLST=8),(IBBILL="") S IBBILL="ON HOLD"
. . I (LOOP=IBUCIEN2),($P(IBDATA,U,7)'=30) Q ;Captures all of the DG FEE NEW entries from 6/6/2019 to install of IB*2.0*656
. . 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
. . ;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,",1.01)=1 ;Status (2 - Billed or 3- Not Counted)
. . . S:$G(IBBILL)'="" FDA(351.82,"+1,",.05)=IBBILL
. . . 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="^IBE(350.3,",DA=IBVSTIEN
. . . D ^DIE
. . ;Save the entry just processed
. . S ^XTMP("IB20P663",1)=LOOP_U_IBN
. . I $$S^%ZTLOAD() D Q
. . . ;
. . . N ZTRTN,ZTDTH,ZTDESC,ZTIO
. . . ;
. . . ;requeue for later
. . . S ZTRTN="INITUCDB^IB20P663"
. . . S ZTDTH=$$NOW^XLFDT+.01 ; reschedule for 1 hr after time process stopped
. . . S ZTDESC="IB*2.0*663 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
;
NEWCREAS ; New Cancellation Reasons
N LOOP,LIEN,IBDATA,IBCNNM
N X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB,DIK
;
N CANIEN,UPDIEN,SVCIEN,CHGIEN
;
; Grab all of the entries to update
D MES^XPDUTL(" -> Adding new Cancellation Reasons 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
;
;350.3,.01 3 NAME 0;1 FREE TEXT (Required)
;350.3,.02 4 ABBREVIATION 0;2 FREE TEXT
;350.3,.03 5 LIMIT 0;3 Code (3 - Generic)
;
REASDAT ; Fee Service to inactivate
;;UC - DUPLICATE VISIT;UCDUP;3
;;UC - SEQUENCE UPDATE;UCSEQ;3
;;END
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
;
IBUPD ; Inactivate FEE Service Entries
;
N LOOP,LIEN,IBDATA
N X,Y,DIE,DA,DR,DTOUT,DATA
;
; Grab all of the entries to update
F LOOP=1:1:36 D
. ;Extract the new ACTION TYPE to be added.
. S IBDATA=$T(IBDDAT+LOOP)
. S IBDATA=$P(IBDATA,";;",2)
. ;Store in array for adding to the file (#350.1).
. Q:IBDATA="" ;go to next entry if Category is not to be updated.
. S LIEN=$O(^IBE(350.1,"B",IBDATA,"")) ; find ACTION TYPE entry
. Q:LIEN=""
. ;
. ; File the update along with inactivate the ACTION TYPE
. S DR=".12////1;"
. S DIE="^IBE(350.1,",DA=LIEN
. D ^DIE
. K DR ;Clear update array before next use
;
S DR=""
D MES^XPDUTL(" -> Data CHOICE and CC MTF Action Types in the ACTION TYPE file (#350.1) inactiavated.")
Q
;
IBDDAT ; Fee Service to inactivate
;;CC MTF (INPT) CANCEL
;;CC MTF (INPT) NEW
;;CC MTF (INPT) UPDATE
;;CC MTF (OPT) CANCEL
;;CC MTF (OPT) NEW
;;CC MTF (OPT) UPDATE
;;CC MTF (PER DIEM) CANCEL
;;CC MTF (PER DIEM) NEW
;;CC MTF (PER DIEM) UPDATE
;;CC MTF (RX) CANCEL
;;CC MTF (RX) NEW
;;CC MTF (RX) UPDATE
;;LTC CHOICE INPT CNH CANCEL
;;LTC CHOICE INPT CNH NEW
;;LTC CHOICE INPT CNH UPDATE
;;LTC CHOICE INPT RESPITE CANCEL
;;LTC CHOICE INPT RESPITE NEW
;;LTC CHOICE INPT RESPITE UPDATE
;;LTC CHOICE OPT ADHC CANCEL
;;LTC CHOICE OPT ADHC NEW
;;LTC CHOICE OPT ADHC UPDATE
;;LTC CHOICE OPT RESPITE CANCEL
;;LTC CHOICE OPT RESPITE NEW
;;LTC CHOICE OPT RESPITE UPDATE
;;CHOICE (INPT) CANCEL
;;CHOICE (INPT) NEW
;;CHOICE (INPT) UPDATE
;;CHOICE (OPT) CANCEL
;;CHOICE (OPT) NEW
;;CHOICE (OPT) UPDATE
;;CHOICE (PER DIEM) CANCEL
;;CHOICE (PER DIEM) NEW
;;CHOICE (PER DIEM) UPDATE
;;CHOICE (RX) CANCEL
;;CHOICE (RX) NEW
;;CHOICE (RX) UPDATE
;;END
;
;
TSKPUSH ; task the routine as a Night Job using TaskMan.
;
N DIC,DLAYGO,TSTAMP,X,Y
D MES^XPDUTL("Tasking Nightly Copay Synch ... ")
;
I $$FIND1^DIC(19.2,,"B","IBUC MULTI FAC COPAY SYNCH","B") D MES^XPDUTL(" Already scheduled") Q ; don't overwrite existing schedule
S (DLAYGO,DIC)=19.2,DIC(0)="L"
S X="IBUC MUTLI FAC COPAY SYNCH"
S TSTAMP=$$FMADD^XLFDT($$NOW^XLFDT(),1),$P(TSTAMP,".",2)="0200"
S DIC("DR")="2////"_TSTAMP_";6////D@2AM"
D ^DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P663 9732 printed Dec 13, 2024@02:04:23 Page 2
IB20P663 ;/Albany - IB*2.0*663 POST INSTALL;07/25/19 2:10pm
+1 ;;2.0;Integrated Billing;**663**;Mar 20, 1995;Build 27
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POSTINIT ;Post Install for IB*2.0*663
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*663")
+2 ; Adding AR CATEGORIES and REVENUE SOURCE CODES
+3 ;D QUEUEINT
+4 ; Load initial data into Visit tracking DB
DO INITUCDB
+5 ; Add more UC reason codes.
DO NEWCREAS
+6 ; Inactivate CHOICE and CC MTF Action Types
DO IBUPD
+7 ; add the nightly task
DO TSKPUSH
+8 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*663")
+9 QUIT
+10 ;
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^IB20P663"
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTDESC="IB*2.0*663 Initialize 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,IBUCIEN2,IBQUIT,IBN,IBDATA,IBDFN,IBVST,IBERR1,IBERR2
+3 NEW IBVSTIEN,IBSTAT,IBBILL,IBBLST,IBREAS,IBLSDTA,IBSITE,IBUCIEN3,IBUCIEN4
+4 NEW X,Y,DIE,DA,DR,DLAYGO,DIC,DINUM
+5 ;
+6 ; Check to see if previously installed. If so, exit with message.
+7 IF $ORDER(^IBUC(351.82,0))]""
Begin DoDot:1
+8 DO BMES^XPDUTL(" >> Urgent Care Visit Tracking Database present. Initialization not tasked.")
End DoDot:1
QUIT
+9 ;
+10 ;Looping through initially for adds
+11 SET IBUCIEN1=$ORDER(^IBE(350.1,"B","CC URGENT CARE (OPT) NEW",""))
+12 SET IBUCIEN2=$ORDER(^IBE(350.1,"B","DG FEE SERVICE (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 SET IBERR1=$ORDER(^IBE(350.3,"B","UC - ENTERED IN ERROR",""))
+16 SET IBERR2=$ORDER(^IBE(350.3,"B","UC - DUPLICATE VISIT",""))
+17 ;Defines variable IBSITE
DO SITE^IBAUTL
+18 ;
+19 SET IBQUIT=0
+20 ;
+21 ;Initialize process tracking array in case initialization stops
+22 NEW X,X2,X1,DT
+23 SET DT=$$DT^XLFDT
SET X1=DT
SET X2=30
DO C^%DTC
+24 SET ^XTMP("IB20P663",0)=X_U_DT_U_"IB*2.0*663 Post install Urgent Care Visit Tracking Initialization"
+25 ;
+26 FOR LOOP=IBUCIEN1,IBUCIEN2,IBUCIEN3,IBUCIEN4
Begin DoDot:1
+27 ;
+28 SET IBN=0
+29 ;
+30 ;See if the initialization was halted. If so, restore loop variables to last entry processed.
+31 IF $DATA(^XTMP("IB20P663",1))
SET IBLSDTA=$GET(^XTMP("IB20P663",1))
SET LOOP=$PIECE(IBLSDTA,U)
SET IBN=$PIECE(IBLSDTA,U,2)
+32 ;
+33 FOR
SET IBN=$ORDER(^IB("AE",LOOP,IBN))
if 'IBN
QUIT
Begin DoDot:2
+34 ; Get the data
SET IBDATA=$GET(^IB(IBN,0))
+35 if IBDATA=""
QUIT
+36 SET IBDFN=$PIECE(IBDATA,U,2)
SET IBVST=$PIECE(IBDATA,U,14)
SET IBVSTIEN=0
+37 ;Do not count UC visits prior to the start of the UC program on 6/6/2019
if IBVST<3190606
QUIT
+38 SET IBVSTIEN=$$DBCHK(IBDFN,IBVST)
+39 ;don't process if visit already in DB and adding a new paid visit
IF ((LOOP=IBUCIEN1)!(LOOP=IBUCIEN2))
IF +IBVSTIEN
QUIT
+40 ;init variables
SET IBSTAT=2
SET (IBBILL,IBREAS)=""
+41 ; Get the bill status
SET IBBLST=$PIECE(IBDATA,U,5)
+42 ;If Bill cancelled because UC entered in error, then set status to not counted, reason to Entered In Error.
+43 IF IBBLST=10
Begin DoDot:3
+44 ;UC-ENTERED IN ERROR
IF ($PIECE(IBDATA,U,10)=IBERR1)
SET IBSTAT=3
SET IBREAS=3
+45 ;UC-DUPLICATE EVENT
IF ($PIECE(IBDATA,U,10)=IBERR2)
SET IBSTAT=3
SET IBREAS=4
End DoDot:3
+46 ;Billing Number
if IBBLST'=10
SET IBBILL=$PIECE(IBDATA,U,11)
+47 IF (IBBLST=8)
IF (IBBILL="")
SET IBBILL="ON HOLD"
+48 ;Captures all of the DG FEE NEW entries from 6/6/2019 to install of IB*2.0*656
IF (LOOP=IBUCIEN2)
IF ($PIECE(IBDATA,U,7)'=30)
QUIT
+49 ;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
+50 ;Add new entry to the tracking database
+51 IF (IBVSTIEN=0)
Begin DoDot:3
+52 KILL FDA
+53 ;Store in array for adding to the file (#351.82)
+54 ;Patient
SET FDA(351.82,"+1,",.01)=IBDFN
+55 ;Site
SET FDA(351.82,"+1,",.02)=IBSITE
+56 ;Visit Date
SET FDA(351.82,"+1,",.03)=IBVST
+57 ;Status (2 - Billed or 3- Not Counted)
SET FDA(351.82,"+1,",.04)=IBSTAT
+58 ;Status (2 - Billed or 3- Not Counted)
SET FDA(351.82,"+1,",1.01)=1
+59 if $GET(IBBILL)'=""
SET FDA(351.82,"+1,",.05)=IBBILL
+60 ;Reason (Not counted)
if $GET(IBREAS)'=""
SET FDA(351.82,"+1,",.06)=IBREAS
+61 SET FDA(351.82,"+1,",1.01)=1
+62 ;Add to the file.
+63 DO UPDATE^DIE(,"FDA","FDAIEN")
+64 SET FDAIEN=FDAIEN(1)
KILL FDAIEN(1)
End DoDot:3
QUIT
+65 ;
+66 ;Otherwise Taking a canceled visit and updating the reason, bill no, and status fields
+67 IF IBVSTIEN'=0
Begin DoDot:3
+68 SET DLAYGO=351.82
SET DIC="^IBUC(351.82,"
SET DIC(0)="L"
+69 IF '+$GET(IBVSTIEN)
DO FILE^DICN
SET LIEN=+IBVSTIEN
KILL DIC,DINUM,DLAYGO
+70 ; Visit Tracking Status
SET DR=".04////"_IBSTAT
+71 ; Bill Number (should reset to NULL)
SET DR=DR_";.05////"_IBBILL
+72 ; Reason (should be UC-ENTERED IN ERROR or UC-Duplicate Event)
SET DR=DR_";.06////"_IBREAS
+73 ; Flag for multi-site transmission
SET DR=DR_";1.01////1"
+74 ;
+75 SET DIE="^IBE(350.3,"
SET DA=IBVSTIEN
+76 DO ^DIE
End DoDot:3
+77 ;Save the entry just processed
+78 SET ^XTMP("IB20P663",1)=LOOP_U_IBN
+79 IF $$S^%ZTLOAD()
Begin DoDot:3
+80 ;
+81 NEW ZTRTN,ZTDTH,ZTDESC,ZTIO
+82 ;
+83 ;requeue for later
+84 SET ZTRTN="INITUCDB^IB20P663"
+85 ; reschedule for 1 hr after time process stopped
SET ZTDTH=$$NOW^XLFDT+.01
+86 SET ZTDESC="IB*2.0*663 Initialize File 351.82 - Urgent Care Visit Tracking DB"
+87 SET ZTIO=""
+88 ; Call TaskManager
DO ^%ZTLOAD
+89 SET IBQUIT=1
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
if IBQUIT
QUIT
+90 ;Clear update array before next use
KILL DR
+91 QUIT
+92 ;
NEWCREAS ; New Cancellation Reasons
+1 NEW LOOP,LIEN,IBDATA,IBCNNM
+2 NEW X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB,DIK
+3 ;
+4 NEW CANIEN,UPDIEN,SVCIEN,CHGIEN
+5 ;
+6 ; Grab all of the entries to update
+7 DO MES^XPDUTL(" -> Adding new Cancellation Reasons 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 ;
+30 ;350.3,.01 3 NAME 0;1 FREE TEXT (Required)
+31 ;350.3,.02 4 ABBREVIATION 0;2 FREE TEXT
+32 ;350.3,.03 5 LIMIT 0;3 Code (3 - Generic)
+33 ;
REASDAT ; Fee Service to inactivate
+1 ;;UC - DUPLICATE VISIT;UCDUP;3
+2 ;;UC - SEQUENCE UPDATE;UCSEQ;3
+3 ;;END
+4 QUIT
+5 ;
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 ;
IBUPD ; Inactivate FEE Service Entries
+1 ;
+2 NEW LOOP,LIEN,IBDATA
+3 NEW X,Y,DIE,DA,DR,DTOUT,DATA
+4 ;
+5 ; Grab all of the entries to update
+6 FOR LOOP=1:1:36
Begin DoDot:1
+7 ;Extract the new ACTION TYPE to be added.
+8 SET IBDATA=$TEXT(IBDDAT+LOOP)
+9 SET IBDATA=$PIECE(IBDATA,";;",2)
+10 ;Store in array for adding to the file (#350.1).
+11 ;go to next entry if Category is not to be updated.
if IBDATA=""
QUIT
+12 ; find ACTION TYPE entry
SET LIEN=$ORDER(^IBE(350.1,"B",IBDATA,""))
+13 if LIEN=""
QUIT
+14 ;
+15 ; File the update along with inactivate the ACTION TYPE
+16 SET DR=".12////1;"
+17 SET DIE="^IBE(350.1,"
SET DA=LIEN
+18 DO ^DIE
+19 ;Clear update array before next use
KILL DR
End DoDot:1
+20 ;
+21 SET DR=""
+22 DO MES^XPDUTL(" -> Data CHOICE and CC MTF Action Types in the ACTION TYPE file (#350.1) inactiavated.")
+23 QUIT
+24 ;
IBDDAT ; Fee Service to inactivate
+1 ;;CC MTF (INPT) CANCEL
+2 ;;CC MTF (INPT) NEW
+3 ;;CC MTF (INPT) UPDATE
+4 ;;CC MTF (OPT) CANCEL
+5 ;;CC MTF (OPT) NEW
+6 ;;CC MTF (OPT) UPDATE
+7 ;;CC MTF (PER DIEM) CANCEL
+8 ;;CC MTF (PER DIEM) NEW
+9 ;;CC MTF (PER DIEM) UPDATE
+10 ;;CC MTF (RX) CANCEL
+11 ;;CC MTF (RX) NEW
+12 ;;CC MTF (RX) UPDATE
+13 ;;LTC CHOICE INPT CNH CANCEL
+14 ;;LTC CHOICE INPT CNH NEW
+15 ;;LTC CHOICE INPT CNH UPDATE
+16 ;;LTC CHOICE INPT RESPITE CANCEL
+17 ;;LTC CHOICE INPT RESPITE NEW
+18 ;;LTC CHOICE INPT RESPITE UPDATE
+19 ;;LTC CHOICE OPT ADHC CANCEL
+20 ;;LTC CHOICE OPT ADHC NEW
+21 ;;LTC CHOICE OPT ADHC UPDATE
+22 ;;LTC CHOICE OPT RESPITE CANCEL
+23 ;;LTC CHOICE OPT RESPITE NEW
+24 ;;LTC CHOICE OPT RESPITE UPDATE
+25 ;;CHOICE (INPT) CANCEL
+26 ;;CHOICE (INPT) NEW
+27 ;;CHOICE (INPT) UPDATE
+28 ;;CHOICE (OPT) CANCEL
+29 ;;CHOICE (OPT) NEW
+30 ;;CHOICE (OPT) UPDATE
+31 ;;CHOICE (PER DIEM) CANCEL
+32 ;;CHOICE (PER DIEM) NEW
+33 ;;CHOICE (PER DIEM) UPDATE
+34 ;;CHOICE (RX) CANCEL
+35 ;;CHOICE (RX) NEW
+36 ;;CHOICE (RX) UPDATE
+37 ;;END
+38 ;
+39 ;
TSKPUSH ; task the routine as a Night Job using TaskMan.
+1 ;
+2 NEW DIC,DLAYGO,TSTAMP,X,Y
+3 DO MES^XPDUTL("Tasking Nightly Copay Synch ... ")
+4 ;
+5 ; don't overwrite existing schedule
IF $$FIND1^DIC(19.2,,"B","IBUC MULTI FAC COPAY SYNCH","B")
DO MES^XPDUTL(" Already scheduled")
QUIT
+6 SET (DLAYGO,DIC)=19.2
SET DIC(0)="L"
+7 SET X="IBUC MUTLI FAC COPAY SYNCH"
+8 SET TSTAMP=$$FMADD^XLFDT($$NOW^XLFDT(),1)
SET $PIECE(TSTAMP,".",2)="0200"
+9 SET DIC("DR")="2////"_TSTAMP_";6////D@2AM"
+10 DO ^DIC
+11 QUIT
