IB20P663.m

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 ---IB20P663   9732     printed  Feb 18, 2025@23:30:45                                                                                                                                                                                                    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