IBBSHDWN ;WOIFO/CLC - IB Sunset for PFSS ;7-JUN-2005
 ;;2.0;INTEGRATED BILLING;**312**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;********************************************************
 ; PURPOSE: Sunset IB Options/functionality
 ;        :
 ;        : *** The CHKSHDWN TAG is NOT currently being utilized **
 ;        : 
 ;
 ;   USAGE: PFSS - Patch(IB*2.0*312) routine
 ;
 ;*******************************************************************
 ; @INPUTS: SRC- The Source Routine, Used for Text Tags
 ;        : KEY- Identifier from Source Ex: AUTO BILLER
 ; @OUTPUTS: Boolean - True=Function Shutdown, False=Function is OK 
 ;*******************************************************************
CHKSHDWN(SRC,KEY) ;
 N SWINFO,I,ITEM,POP,RET,TAG
 S SWINFO=$$SWSTAT^IBBAPI()
 ;
 S (RET,POP)=0
 F I=1:1 S ITEM=$T(@SRC+I) Q:ITEM["%%%"  D  Q:POP
    .Q:$TR($P(ITEM,";",4)," ","")'=KEY
    .;
    .S TAG=$TR($P(ITEM,";",5)," ","")
    .I TAG="" S POP=1,RET=+SWINFO            ;No additional logic
    .;
    .D @TAG
 Q RET
IBAMTD ;
 ;;;CLAIMS TRACKING  ;        ; Disable Claims Tracking
 ;;;TRANSFER PRICING ;        ; Disable Transfer Pricing
 ;;;LTC CLOCK        ;        ; Disable LTC Clock Creation
 ;;;CHAMPVA          ;        ; Disable Co-Pay Chgs for ChampVA
 ;;;CONT HOSP PAT    ;        ; Disable Unflaf Cont Hosp Pats
 ;;;SPECIAL INPAT    ;        ; Disable Special Inpat Cases
 ;;;OBSERVATION COPAY;        ; Disable Observation Copay
 ;;;INPATIENT EVENTS ;        ; Disable Inpatient Event Charges
 ;;;%%%
IBAMTS ;
 ;;;TRANSFER PRICING ;        ; Disable Transfer Pricing
 ;;;LTC CLOCK        ;        ; Disable LTC Clock Co-pay
 ;;;OUTPAT MT COPAY  ;        ; Disable Out Pat MT Co-Pay
 ;;;%%%
IBAMTC ;
 ;;;CLAIMS TRACKING  ;        ; Disable Claims Tracking
 ;;;AUTO BILLER      ;ATOBILL ; Adjust Auto-Biller Logic
 ;;;TRANSFER PRICING ;        ; Disable Transfer Pricing
 ;;;%%%
 Q
 ;*******************************************************************
 ; @INPUTS: None
 ; @OUTPUTS: 1/0 1=User wants to continue, 0= DO Not continue
 ;*******************************************************************
PFSSWARN() ;
 N DIR,DIRUT,DTOUT,X,Y,IBSTAR,IBSWINFO
 S IBSTAR80="",$P(IBSTAR,"*",55)="",Y=1
 S IBSWINFO=$$SWSTAT^IBBAPI() G:'+IBSWINFO WARNQ
 D HOME^%ZIS  W @IOF
 S DIR(0)="YAO",DIR("B")="N"
 S DIR("A",1)=IBSTAR,DIR("A",3)=""
 S DIR("A",2)="The PFSS Environment is active as of "_$$FMTE^XLFDT($P(IBSWINFO,"^",2))_"."
 S DIR("A",4)="The action you are trying to perform may not be valid"
 S DIR("A",5)="for services provided on or after this date."
 S DIR("A",6)=IBSTAR
 S DIR("A")="Are you SURE you want to continue? "
 D ^DIR
 I $D(DIRUT)!$D(DTOUT) S Y=""
WARNQ Q Y
 ;*******************************************************************
 ; @INPUTS: Action = 1-ReInstate Option 0-(Default)-Set Out of Order
 ; @OUTPUTS: Mailman message indicating Invalid Options or Sucess...
 ;*******************************************************************
UPDOPTS(ACT) ;
 N SPC,I,OPT,DN,DA,DIC,DIE,DR,MSG,DETAIL
 S MSG="Option is unavailable with PFSS Active"
 S SPC="",$P(SPC," ",50)=""
 I $G(ACT)=1 S MSG="@"
 F I=1:1 S OPT=$T(OPTIONS+I) Q:OPT["%%%"  D
    .S DN=$P(OPT,";",4)
    .I '$D(^DIC(19,"B",DN)) S DETAIL(I)=$E(DN_SPC,1,30)_"Invalid Name" Q
    .;
    .; IA#1157 - Extrinsic functions to manage fields in OPTION file
    .D OUT^XPDMENU(DN,MSG)
 ;
 I '$D(DETAIL) S DETAIL(1)="All IB Sunset Options - Flagged:"_MSG
 D NOTIFY
 Q
UPDBTCEX(ACT) ;
 N DA,DIE,DR,DETAIL
 I $G(ACT)'=1 S ACT=0
 S DA=0
 F  S DA=$O(^IBE(350.9,1,51.17,DA)) Q:+DA=0  D
    .I ",1,2,3,4,"'[$P($G(^IBE(350.9,1,51.17,DA,0)),"^",1) Q
    .S DIE="^IBE(350.9,1,51.17,",DR=".02///"_ACT D ^DIE
 S DETAIL(1)="Batch Extracts Status Set to: "_ACT
 D NOTIFY
 Q
NOTIFY ;
 N XMDF,XMDUZ,XMSUB,XMDUN,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMMG
 S XMDF="",XMDUZ="IBBSHDWN-"_$TR($P($$SITE^VASITE(),"^",2,3),"^","-")
 S XMY(DUZ)="",XMY("G.PATCHES")=""
 S XMSUB="IB-SUNSET OPTIONS"
 S XMTEXT="DETAIL("
 D ^XMD
 Q
OPTIONS ;
 ;;;IB FLAG CONTINUOUS PATIENTS
 ;;;IB MT CLOCK MAINTENANCE
 ;;;IB CLEAN AUTO BILLER LIST
 ;;;IB OUTPUT AUTO BILLER
 ;;;IB TRICARE DEL REJECT
 ;;;IB TRICARE REJECT
 ;;;IB TRICARE RESUBMIT
 ;;;IB TRICARE REVERSE
 ;;;IB TRICARE TRANSMISSION
 ;;;IBAEC LTC CLOCK EDIT
 ;;;IBCR ENTER TP NEG RATES
 ;;;IBCN INSURANCE BUFFER PROCESS
 ;;;IBCN MEDICARE INSURANCE INTAKE
 ;;;IBCNE AUTO MATCH BUFFER
 ;;;IBCNE AUTO MATCH ENTER/EDIT
 ;;;IBT EDIT HR REVIEWS TO DO
 ;;;IBT EDIT HR TRACKING ENTRY
 ;;;IBT EDIT REVIEWS
 ;;;IB PURGE BILLING DATA
 ;;;IB PURGE DELETE TEMPLATE ENTRY
 ;;;IB PURGE LIST LOG ENTRIES
 ;;;IB PURGE LIST TEMPLATE ENTRIES
 ;;;IB PURGE LOG INQUIRY
 ;;;IB PURGE/ARCHIVE BILLING DATA
 ;;;IB PURGE/FIND BILLING DATA
 ;;;IBCNE PURGE IIV DATA
 ;;;IBAT EXCEL REPORT
 ;;;IBAT INPT PROSTHETIC ITEMS
 ;;;IBAT PATIENT LIST
 ;;;IBAT PATIENT REPORT
 ;;;IBAT SUMMARY REPORT
 ;;;IBAT TP MANAGEMENT
 ;;;IBAT WORKLOAD REPORT
 ;;;IBCI CLAIMSMANAGER NPT FILE
 ;;;IBCI CLAIMSMANAGER PAYOR FILE
 ;;;IBT RE-GEN AVE BILL AMOUNT
 ;;;IBT RE-GEN UNBILLED REPORT
 ;;;IBT SEND TEST UNBILLED MESS
 ;;;IBT VIEW UNBILLED AMOUNTS
 ;;;IBJD UTILIZATION WORKLOAD
 ;;;IBT MONTHLY AUTO GEN AVE BILL
 ;;;IBT MONTHLY AUTO GEN UNBILLED
 ;;;IB MRA EXTRACT
 ;;%%%
 Q
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBBSHDWN   5401     printed  Sep 23, 2025@19:44:41                                                                                                                                                                                                    Page 2
IBBSHDWN  ;WOIFO/CLC - IB Sunset for PFSS ;7-JUN-2005
 +1       ;;2.0;INTEGRATED BILLING;**312**;21-MAR-94
 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.
 +3       ;********************************************************
 +4       ; PURPOSE: Sunset IB Options/functionality
 +5       ;        :
 +6       ;        : *** The CHKSHDWN TAG is NOT currently being utilized **
 +7       ;        : 
 +8       ;
 +9       ;   USAGE: PFSS - Patch(IB*2.0*312) routine
 +10      ;
 +11      ;*******************************************************************
 +12      ; @INPUTS: SRC- The Source Routine, Used for Text Tags
 +13      ;        : KEY- Identifier from Source Ex: AUTO BILLER
 +14      ; @OUTPUTS: Boolean - True=Function Shutdown, False=Function is OK 
 +15      ;*******************************************************************
CHKSHDWN(SRC,KEY) ;
 +1        NEW SWINFO,I,ITEM,POP,RET,TAG
 +2        SET SWINFO=$$SWSTAT^IBBAPI()
 +3       ;
 +4        SET (RET,POP)=0
 +5        FOR I=1:1
               SET ITEM=$TEXT(@SRC+I)
               if ITEM["%%%"
                   QUIT 
               Begin DoDot:1
 +6                if $TRANSLATE($PIECE(ITEM,";",4)," ","")'=KEY
                       QUIT 
 +7       ;
 +8                SET TAG=$TRANSLATE($PIECE(ITEM,";",5)," ","")
 +9       ;No additional logic
                   IF TAG=""
                       SET POP=1
                       SET RET=+SWINFO
 +10      ;
 +11               DO @TAG
               End DoDot:1
               if POP
                   QUIT 
 +12       QUIT RET
IBAMTD    ;
 +1       ;;;CLAIMS TRACKING  ;        ; Disable Claims Tracking
 +2       ;;;TRANSFER PRICING ;        ; Disable Transfer Pricing
 +3       ;;;LTC CLOCK        ;        ; Disable LTC Clock Creation
 +4       ;;;CHAMPVA          ;        ; Disable Co-Pay Chgs for ChampVA
 +5       ;;;CONT HOSP PAT    ;        ; Disable Unflaf Cont Hosp Pats
 +6       ;;;SPECIAL INPAT    ;        ; Disable Special Inpat Cases
 +7       ;;;OBSERVATION COPAY;        ; Disable Observation Copay
 +8       ;;;INPATIENT EVENTS ;        ; Disable Inpatient Event Charges
 +9       ;;;%%%
IBAMTS    ;
 +1       ;;;TRANSFER PRICING ;        ; Disable Transfer Pricing
 +2       ;;;LTC CLOCK        ;        ; Disable LTC Clock Co-pay
 +3       ;;;OUTPAT MT COPAY  ;        ; Disable Out Pat MT Co-Pay
 +4       ;;;%%%
IBAMTC    ;
 +1       ;;;CLAIMS TRACKING  ;        ; Disable Claims Tracking
 +2       ;;;AUTO BILLER      ;ATOBILL ; Adjust Auto-Biller Logic
 +3       ;;;TRANSFER PRICING ;        ; Disable Transfer Pricing
 +4       ;;;%%%
 +5        QUIT 
 +6       ;*******************************************************************
 +7       ; @INPUTS: None
 +8       ; @OUTPUTS: 1/0 1=User wants to continue, 0= DO Not continue
 +9       ;*******************************************************************
PFSSWARN() ;
 +1        NEW DIR,DIRUT,DTOUT,X,Y,IBSTAR,IBSWINFO
 +2        SET IBSTAR80=""
           SET $PIECE(IBSTAR,"*",55)=""
           SET Y=1
 +3        SET IBSWINFO=$$SWSTAT^IBBAPI()
           if '+IBSWINFO
               GOTO WARNQ
 +4        DO HOME^%ZIS
           WRITE @IOF
 +5        SET DIR(0)="YAO"
           SET DIR("B")="N"
 +6        SET DIR("A",1)=IBSTAR
           SET DIR("A",3)=""
 +7        SET DIR("A",2)="The PFSS Environment is active as of "_$$FMTE^XLFDT($PIECE(IBSWINFO,"^",2))_"."
 +8        SET DIR("A",4)="The action you are trying to perform may not be valid"
 +9        SET DIR("A",5)="for services provided on or after this date."
 +10       SET DIR("A",6)=IBSTAR
 +11       SET DIR("A")="Are you SURE you want to continue? "
 +12       DO ^DIR
 +13       IF $DATA(DIRUT)!$DATA(DTOUT)
               SET Y=""
WARNQ      QUIT Y
 +1       ;*******************************************************************
 +2       ; @INPUTS: Action = 1-ReInstate Option 0-(Default)-Set Out of Order
 +3       ; @OUTPUTS: Mailman message indicating Invalid Options or Sucess...
 +4       ;*******************************************************************
UPDOPTS(ACT) ;
 +1        NEW SPC,I,OPT,DN,DA,DIC,DIE,DR,MSG,DETAIL
 +2        SET MSG="Option is unavailable with PFSS Active"
 +3        SET SPC=""
           SET $PIECE(SPC," ",50)=""
 +4        IF $GET(ACT)=1
               SET MSG="@"
 +5        FOR I=1:1
               SET OPT=$TEXT(OPTIONS+I)
               if OPT["%%%"
                   QUIT 
               Begin DoDot:1
 +6                SET DN=$PIECE(OPT,";",4)
 +7                IF '$DATA(^DIC(19,"B",DN))
                       SET DETAIL(I)=$EXTRACT(DN_SPC,1,30)_"Invalid Name"
                       QUIT 
 +8       ;
 +9       ; IA#1157 - Extrinsic functions to manage fields in OPTION file
 +10               DO OUT^XPDMENU(DN,MSG)
               End DoDot:1
 +11      ;
 +12       IF '$DATA(DETAIL)
               SET DETAIL(1)="All IB Sunset Options - Flagged:"_MSG
 +13       DO NOTIFY
 +14       QUIT 
UPDBTCEX(ACT) ;
 +1        NEW DA,DIE,DR,DETAIL
 +2        IF $GET(ACT)'=1
               SET ACT=0
 +3        SET DA=0
 +4        FOR 
               SET DA=$ORDER(^IBE(350.9,1,51.17,DA))
               if +DA=0
                   QUIT 
               Begin DoDot:1
 +5                IF ",1,2,3,4,"'[$PIECE($GET(^IBE(350.9,1,51.17,DA,0)),"^",1)
                       QUIT 
 +6                SET DIE="^IBE(350.9,1,51.17,"
                   SET DR=".02///"_ACT
                   DO ^DIE
               End DoDot:1
 +7        SET DETAIL(1)="Batch Extracts Status Set to: "_ACT
 +8        DO NOTIFY
 +9        QUIT 
NOTIFY    ;
 +1        NEW XMDF,XMDUZ,XMSUB,XMDUN,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMMG
 +2        SET XMDF=""
           SET XMDUZ="IBBSHDWN-"_$TRANSLATE($PIECE($$SITE^VASITE(),"^",2,3),"^","-")
 +3        SET XMY(DUZ)=""
           SET XMY("G.PATCHES")=""
 +4        SET XMSUB="IB-SUNSET OPTIONS"
 +5        SET XMTEXT="DETAIL("
 +6        DO ^XMD
 +7        QUIT 
OPTIONS   ;
 +1       ;;;IB FLAG CONTINUOUS PATIENTS
 +2       ;;;IB MT CLOCK MAINTENANCE
 +3       ;;;IB CLEAN AUTO BILLER LIST
 +4       ;;;IB OUTPUT AUTO BILLER
 +5       ;;;IB TRICARE DEL REJECT
 +6       ;;;IB TRICARE REJECT
 +7       ;;;IB TRICARE RESUBMIT
 +8       ;;;IB TRICARE REVERSE
 +9       ;;;IB TRICARE TRANSMISSION
 +10      ;;;IBAEC LTC CLOCK EDIT
 +11      ;;;IBCR ENTER TP NEG RATES
 +12      ;;;IBCN INSURANCE BUFFER PROCESS
 +13      ;;;IBCN MEDICARE INSURANCE INTAKE
 +14      ;;;IBCNE AUTO MATCH BUFFER
 +15      ;;;IBCNE AUTO MATCH ENTER/EDIT
 +16      ;;;IBT EDIT HR REVIEWS TO DO
 +17      ;;;IBT EDIT HR TRACKING ENTRY
 +18      ;;;IBT EDIT REVIEWS
 +19      ;;;IB PURGE BILLING DATA
 +20      ;;;IB PURGE DELETE TEMPLATE ENTRY
 +21      ;;;IB PURGE LIST LOG ENTRIES
 +22      ;;;IB PURGE LIST TEMPLATE ENTRIES
 +23      ;;;IB PURGE LOG INQUIRY
 +24      ;;;IB PURGE/ARCHIVE BILLING DATA
 +25      ;;;IB PURGE/FIND BILLING DATA
 +26      ;;;IBCNE PURGE IIV DATA
 +27      ;;;IBAT EXCEL REPORT
 +28      ;;;IBAT INPT PROSTHETIC ITEMS
 +29      ;;;IBAT PATIENT LIST
 +30      ;;;IBAT PATIENT REPORT
 +31      ;;;IBAT SUMMARY REPORT
 +32      ;;;IBAT TP MANAGEMENT
 +33      ;;;IBAT WORKLOAD REPORT
 +34      ;;;IBCI CLAIMSMANAGER NPT FILE
 +35      ;;;IBCI CLAIMSMANAGER PAYOR FILE
 +36      ;;;IBT RE-GEN AVE BILL AMOUNT
 +37      ;;;IBT RE-GEN UNBILLED REPORT
 +38      ;;;IBT SEND TEST UNBILLED MESS
 +39      ;;;IBT VIEW UNBILLED AMOUNTS
 +40      ;;;IBJD UTILIZATION WORKLOAD
 +41      ;;;IBT MONTHLY AUTO GEN AVE BILL
 +42      ;;;IBT MONTHLY AUTO GEN UNBILLED
 +43      ;;;IB MRA EXTRACT
 +44      ;;%%%
 +45       QUIT 
 +46       QUIT