source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBEMTF.m@ 1154

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1IBEMTF ;ALB/CPM - FLAG STOP CODES, DISPOSITIONS, AND CLINICS ; 22-JUL-93
2 ;;2.0;INTEGRATED BILLING;**167**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; Option entry point - main processing loop.
6 ;
7 ; per patch ib*2*167, this option no longer valid
8 ;
9 W !!,"Due to the new Means Test Copayment Tier, this option, is no longer used!",!!
10 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT S DIR(0)="E" D ^DIR
11 Q
12 ;
13 ;
14 ;
15 S IBQ=0 F D UPD Q:IBQ
16 K IBQ
17 Q
18 ;
19UPD ; Update the billable status for stop codes, dispositions, or clinics.
20 W @IOF,*13,?6,"Flag Stop Codes, Dispositions, and Clinics for Means Test Billing"
21 W !,$$DASH(),!,"This option is used to set up Clinic Stop Codes, Dispositions, and Clinics"
22 W !,"as either non-billable or billable for the Means Test Outpatient Copayment."
23 W !!,"Use of this option will have an immediate effect on your billing operations,"
24 W !,"so you should have your work pre-planned before using this option.",!,$$DASH()
25 ;
26 ; - select stop codes, dispositions, or clinics.
27 S DIR(0)="SO^S:STOP CODES;D:DISPOSITIONS;C:CLINICS",DIR("?")="^D HSEL^IBEMTF1"
28 S DIR("A")="Enter your choice" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) G UPDQ
29 S IBINFO=$T(@Y+1)
30 ;
31 ; - some help
32 W !!,$$DASH(),!,"You may now enter the ",$P(IBINFO,";",3)," that you wish to flag. Please note"
33 W !,"all ",$P(IBINFO,";",3)," that you select will be assigned the same effective"
34 W !,"date and billable status.",!,$$DASH(),!
35 ;
36 ; - select all entries to be updated
37 S (IBNUM,IBHIT)=0 D UPDQ1 F D Q:Y<0
38 .S DIC=$P(IBINFO,";",5),DIC(0)="QEAMZ"
39 .S DIC("A")=$S(IBHIT:"Next",1:"Select")_" "_$P(IBINFO,";",4)_": "
40 .S:$P(IBINFO,";",6)]"" DIC("S")=$P(IBINFO,";",6)
41 .D ^DIC K DIC Q:Y<0 S IBHIT=1
42 .I $D(^TMP("IBEMTF",$J,+Y)) W !,"Please note that you've already selected ",Y(0,0),"."
43 .E S ^TMP("IBEMTF",$J,+Y)=Y(0,0),IBNUM=IBNUM+1
44 ;
45 ; - quit if no selections were made.
46 I '$D(^TMP("IBEMTF",$J)) W !!,"No ",$P(IBINFO,";",3)," selected!" S IBQ=1 G UPDQ
47 ;
48 ; - allow review of the selections.
49 I IBNUM>1 D REV^IBEMTF1 I IBQ G UPDQ
50 ;
51 ; - quit if all entries were de-selected (but allow re-start).
52 I '$D(^TMP("IBEMTF",$J)) W !!,"All ",$P(IBINFO,";",3)," were de-selected!" G UPDQ
53 ;
54 ; - should Means Test billing be ignored or activated?
55 S DIR(0)="Y",DIR("A")="Ignore Means Test billing for "_$S(IBNUM=1:"this",1:"these")_" "_$P(IBINFO,";",$S(IBNUM=1:7,1:3))
56 S DIR("?")="^D HACT^IBEMTF1"
57 W ! D ^DIR K DIR G:($D(DIRUT))!($D(DUOUT)) UPDQ
58 S IBFILE=+Y,IBACT=$S(IBFILE:"ignore",1:"activate")
59 ;
60 ; - what is the effective date for this action?
61 S %DT="AEX",%DT("A")="Please enter the effective date to "_IBACT_" billing: "
62 D ^%DT K %DT G:Y<0 UPDQ S IBDAT=Y
63 I Y>DT W !!,"Please note that you've selected a future date!"
64 ;
65 ; - re-display the list of selected entries.
66 W !!,"Action to take => ",IBACT," billing for the following ",$P(IBINFO,";",3),":" D LIST^IBEMTF1 W !
67 ;
68 ; - okay to proceed and file entries?
69 S DIR(0)="Y",DIR("A")="Is it okay to proceed and file these entries"
70 S DIR("?")="Enter 'Y' to file these entries, 'N' to try again, or '^' to quit."
71 D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G UPDQ
72 ;
73 ; - file selected entries.
74 W !!,"Filing these ",$P(IBINFO,";",4)," entries... " D FILE^IBEMTF1
75 W ! S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT
76 ;
77UPDQ S:$D(DIRUT)!($D(DUOUT)) IBQ=1
78 K DIRUT,DUOUT,DTOUT,DIROUT,IBINFO,IBNUM,IBFILE,IBACT,IBDAT,IBHIT
79UPDQ1 K ^TMP("IBEMTF",$J)
80 Q
81 ;
82DASH() ; Write a dashed line.
83 Q $TR($J("",79)," ","=")
84 ;
85INFO ; Description of stop/disposition/clinic information listed below.
86 ;;desc (plural);desc (selection);source file root;source screen;desc (sing);dest file root;dest file #
87 ;
88S ; Stop Code Information
89 ;;clinic stop codes;CLINIC STOP CODE;^DIC(40.7,;I '$P(^(0),U,3);clinic stop code;^IBE(352.3,;352.3
90 ;
91D ; Disposition Information
92 ;;dispositions;DISPOSITION;^DIC(37,;I '$P(^(0),U,10);disposition;^IBE(352.2,;352.2
93 ;
94C ; Clinic Information
95 ;;clinics;CLINIC;^SC(;I $P(^(0),U,3)="C";clinic;^IBE(352.4,;352.4
96 ;
Note: See TracBrowser for help on using the repository browser.