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

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1IBATLM0A ;LL/ELZ - TRANSFER PRICING PT LIST LIST MANAGER ; 29-JAN-1999
2 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5AP ; -- adding a patient
6 N DIC,X,Y,DTOUT,DUOUT,%,%Y,IBFAC
7 D LMOPT^IBATUTL
8 S DIC="^DPT(",DIC(0)="AEMNQ",DIC("S")="I '$D(^IBAT(351.6,Y,0))"
9 D ^DIC Q:Y<1 I $$TPP^IBATUTL(+Y) D INIT^IBATLM0 Q
10 W !!,"Currently this patient is not listed as having a Enrolled Facility other"
11 W !,"than your own!",!!,"Do you really want to add this patient? "
12 S DFN=+Y,%=2 D YN^DICN Q:%'=1
13 S IBFAC=$$ONEFAC^IBATUTL I IBFAC S IBFAC=$$PAT^IBATFILE(DFN,,IBFAC)
14 D INIT^IBATLM0
15 Q
16CS ; -- change the status of a patient
17 N IBVAL,DA
18 D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
19 S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
20 S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
21 D CSP(DA),INIT^IBATLM0
22 Q
23 ;
24CSP(DA) ; allows entry from patient level screen to change status
25 ;
26 N DIE,DR,DTOUT
27 S DIE="^IBAT(351.6,",DR=.04 D ^DIE
28 Q
29PI ; -- patient inquiry screen
30 N IBVAL,DFN
31 D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
32 S (DFN,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
33 S DFN=$O(@VALMAR@("INDEX",IBVAL,DFN))
34 D EN^IBATLM3
35 Q
36 ;
37CV ; -- change view (selection of facility or patient)
38 N IBAT D LMOPT^IBATUTL S IBAT=$$SL^IBATUTL Q:'IBAT
39 D @$S(IBAT["IBAT(351.6,":"EN^IBATLM1(+IBAT)",1:"EN^IBATLM0(+IBAT)")
40 S VALMBCK="Q"
41 Q
42SP ; -- select patient and go to transaction list manager
43 N DA,IBVAL
44 D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
45 S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
46 S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
47 D EN^IBATLM1(DA),INIT^IBATLM0
48 Q
49CF ; -- used to change a patient's enrolled facility
50 N DA,IBVAL
51 D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
52 S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
53 S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
54 D CFP(DA),INIT^IBATLM0
55 Q
56CFP(DA) ; allows entry from patient level screen to change facility
57 ;
58 N DIE,DR,DTOUT
59 W !!,"Note: By entering a facility here, ALL future transactions for"
60 W !,"this patient will ALWAYS go to this facility, no matter where the"
61 W !,"patient's enrolled facility may be. The only way to stop this"
62 W !,"for future transactions is to delete the OVERRIDDEN FACILITY.",!
63 S DIE="^IBAT(351.6,",DR=.1 D ^DIE
64 Q
Note: See TracBrowser for help on using the repository browser.