source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBBSHDWN.m@ 923

Last change on this file since 923 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.1 KB
RevLine 
[613]1IBBSHDWN ;WOIFO/CLC - IB Sunset for PFSS ;7-JUN-2005
2 ;;2.0;INTEGRATED BILLING;**312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;********************************************************
5 ; PURPOSE: Sunset IB Options/functionality
6 ; :
7 ; : *** The CHKSHDWN TAG is NOT currently being utilized **
8 ; :
9 ;
10 ; USAGE: PFSS - Patch(IB*2.0*312) routine
11 ;
12 ;*******************************************************************
13 ; @INPUTS: SRC- The Source Routine, Used for Text Tags
14 ; : KEY- Identifier from Source Ex: AUTO BILLER
15 ; @OUTPUTS: Boolean - True=Function Shutdown, False=Function is OK
16 ;*******************************************************************
17CHKSHDWN(SRC,KEY) ;
18 N SWINFO,I,ITEM,POP,RET,TAG
19 S SWINFO=$$SWSTAT^IBBAPI()
20 ;
21 S (RET,POP)=0
22 F I=1:1 S ITEM=$T(@SRC+I) Q:ITEM["%%%" D Q:POP
23 .Q:$TR($P(ITEM,";",4)," ","")'=KEY
24 .;
25 .S TAG=$TR($P(ITEM,";",5)," ","")
26 .I TAG="" S POP=1,RET=+SWINFO ;No additional logic
27 .;
28 .D @TAG
29 Q RET
30IBAMTD ;
31 ;;;CLAIMS TRACKING ; ; Disable Claims Tracking
32 ;;;TRANSFER PRICING ; ; Disable Transfer Pricing
33 ;;;LTC CLOCK ; ; Disable LTC Clock Creation
34 ;;;CHAMPVA ; ; Disable Co-Pay Chgs for ChampVA
35 ;;;CONT HOSP PAT ; ; Disable Unflaf Cont Hosp Pats
36 ;;;SPECIAL INPAT ; ; Disable Special Inpat Cases
37 ;;;OBSERVATION COPAY; ; Disable Observation Copay
38 ;;;INPATIENT EVENTS ; ; Disable Inpatient Event Charges
39 ;;;%%%
40IBAMTS ;
41 ;;;TRANSFER PRICING ; ; Disable Transfer Pricing
42 ;;;LTC CLOCK ; ; Disable LTC Clock Co-pay
43 ;;;OUTPAT MT COPAY ; ; Disable Out Pat MT Co-Pay
44 ;;;%%%
45IBAMTC ;
46 ;;;CLAIMS TRACKING ; ; Disable Claims Tracking
47 ;;;AUTO BILLER ;ATOBILL ; Adjust Auto-Biller Logic
48 ;;;TRANSFER PRICING ; ; Disable Transfer Pricing
49 ;;;%%%
50 Q
51 ;*******************************************************************
52 ; @INPUTS: None
53 ; @OUTPUTS: 1/0 1=User wants to continue, 0= DO Not continue
54 ;*******************************************************************
55PFSSWARN() ;
56 N DIR,DIRUT,DTOUT,X,Y,IBSTAR,IBSWINFO
57 S IBSTAR80="",$P(IBSTAR,"*",55)="",Y=1
58 S IBSWINFO=$$SWSTAT^IBBAPI() G:'+IBSWINFO WARNQ
59 D HOME^%ZIS W @IOF
60 S DIR(0)="YAO",DIR("B")="N"
61 S DIR("A",1)=IBSTAR,DIR("A",3)=""
62 S DIR("A",2)="The PFSS Environment is active as of "_$$FMTE^XLFDT($P(IBSWINFO,"^",2))_"."
63 S DIR("A",4)="The action you are trying to perform may not be valid"
64 S DIR("A",5)="for services provided on or after this date."
65 S DIR("A",6)=IBSTAR
66 S DIR("A")="Are you SURE you want to continue? "
67 D ^DIR
68 I $D(DIRUT)!$D(DTOUT) S Y=""
69WARNQ Q Y
70 ;*******************************************************************
71 ; @INPUTS: Action = 1-ReInstate Option 0-(Default)-Set Out of Order
72 ; @OUTPUTS: Mailman message indicating Invalid Options or Sucess...
73 ;*******************************************************************
74UPDOPTS(ACT) ;
75 N SPC,I,OPT,DN,DA,DIC,DIE,DR,MSG,DETAIL
76 S MSG="Option is unavailable with PFSS Active"
77 S SPC="",$P(SPC," ",50)=""
78 I $G(ACT)=1 S MSG="@"
79 F I=1:1 S OPT=$T(OPTIONS+I) Q:OPT["%%%" D
80 .S DN=$P(OPT,";",4)
81 .I '$D(^DIC(19,"B",DN)) S DETAIL(I)=$E(DN_SPC,1,30)_"Invalid Name" Q
82 .;
83 .; IA#1157 - Extrinsic functions to manage fields in OPTION file
84 .D OUT^XPDMENU(DN,MSG)
85 ;
86 I '$D(DETAIL) S DETAIL(1)="All IB Sunset Options - Flagged:"_MSG
87 D NOTIFY
88 Q
89UPDBTCEX(ACT) ;
90 N DA,DIE,DR,DETAIL
91 I $G(ACT)'=1 S ACT=0
92 S DA=0
93 F S DA=$O(^IBE(350.9,1,51.17,DA)) Q:+DA=0 D
94 .I ",1,2,3,4,"'[$P($G(^IBE(350.9,1,51.17,DA,0)),"^",1) Q
95 .S DIE="^IBE(350.9,1,51.17,",DR=".02///"_ACT D ^DIE
96 S DETAIL(1)="Batch Extracts Status Set to: "_ACT
97 D NOTIFY
98 Q
99NOTIFY ;
100 N XMDF,XMDUZ,XMSUB,XMDUN,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMMG
101 S XMDF="",XMDUZ="IBBSHDWN-"_$TR($P($$SITE^VASITE(),"^",2,3),"^","-")
102 S XMY(DUZ)="",XMY("G.PATCHES")=""
103 S XMSUB="IB-SUNSET OPTIONS"
104 S XMTEXT="DETAIL("
105 D ^XMD
106 Q
107OPTIONS ;
108 ;;;IB FLAG CONTINUOUS PATIENTS
109 ;;;IB MT CLOCK MAINTENANCE
110 ;;;IB CLEAN AUTO BILLER LIST
111 ;;;IB OUTPUT AUTO BILLER
112 ;;;IB TRICARE DEL REJECT
113 ;;;IB TRICARE REJECT
114 ;;;IB TRICARE RESUBMIT
115 ;;;IB TRICARE REVERSE
116 ;;;IB TRICARE TRANSMISSION
117 ;;;IBAEC LTC CLOCK EDIT
118 ;;;IBCR ENTER TP NEG RATES
119 ;;;IBCN INSURANCE BUFFER PROCESS
120 ;;;IBCN MEDICARE INSURANCE INTAKE
121 ;;;IBCNE AUTO MATCH BUFFER
122 ;;;IBCNE AUTO MATCH ENTER/EDIT
123 ;;;IBT EDIT HR REVIEWS TO DO
124 ;;;IBT EDIT HR TRACKING ENTRY
125 ;;;IBT EDIT REVIEWS
126 ;;;IB PURGE BILLING DATA
127 ;;;IB PURGE DELETE TEMPLATE ENTRY
128 ;;;IB PURGE LIST LOG ENTRIES
129 ;;;IB PURGE LIST TEMPLATE ENTRIES
130 ;;;IB PURGE LOG INQUIRY
131 ;;;IB PURGE/ARCHIVE BILLING DATA
132 ;;;IB PURGE/FIND BILLING DATA
133 ;;;IBCNE PURGE IIV DATA
134 ;;;IBAT EXCEL REPORT
135 ;;;IBAT INPT PROSTHETIC ITEMS
136 ;;;IBAT PATIENT LIST
137 ;;;IBAT PATIENT REPORT
138 ;;;IBAT SUMMARY REPORT
139 ;;;IBAT TP MANAGEMENT
140 ;;;IBAT WORKLOAD REPORT
141 ;;;IBCI CLAIMSMANAGER NPT FILE
142 ;;;IBCI CLAIMSMANAGER PAYOR FILE
143 ;;;IBT RE-GEN AVE BILL AMOUNT
144 ;;;IBT RE-GEN UNBILLED REPORT
145 ;;;IBT SEND TEST UNBILLED MESS
146 ;;;IBT VIEW UNBILLED AMOUNTS
147 ;;;IBJD UTILIZATION WORKLOAD
148 ;;;IBT MONTHLY AUTO GEN AVE BILL
149 ;;;IBT MONTHLY AUTO GEN UNBILLED
150 ;;;IB MRA EXTRACT
151 ;;%%%
152 Q
153 Q
Note: See TracBrowser for help on using the repository browser.