IBATLM0A ;LL/ELZ - TRANSFER PRICING PT LIST LIST MANAGER ; 29-JAN-1999
;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
AP ; -- adding a patient
N DIC,X,Y,DTOUT,DUOUT,%,%Y,IBFAC
D LMOPT^IBATUTL
S DIC="^DPT(",DIC(0)="AEMNQ",DIC("S")="I '$D(^IBAT(351.6,Y,0))"
D ^DIC Q:Y<1 I $$TPP^IBATUTL(+Y) D INIT^IBATLM0 Q
W !!,"Currently this patient is not listed as having a Enrolled Facility other"
W !,"than your own!",!!,"Do you really want to add this patient? "
S DFN=+Y,%=2 D YN^DICN Q:%'=1
S IBFAC=$$ONEFAC^IBATUTL I IBFAC S IBFAC=$$PAT^IBATFILE(DFN,,IBFAC)
D INIT^IBATLM0
Q
CS ; -- change the status of a patient
N IBVAL,DA
D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
D CSP(DA),INIT^IBATLM0
Q
;
CSP(DA) ; allows entry from patient level screen to change status
;
N DIE,DR,DTOUT
S DIE="^IBAT(351.6,",DR=.04 D ^DIE
Q
PI ; -- patient inquiry screen
N IBVAL,DFN
D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
S (DFN,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
S DFN=$O(@VALMAR@("INDEX",IBVAL,DFN))
D EN^IBATLM3
Q
;
CV ; -- change view (selection of facility or patient)
N IBAT D LMOPT^IBATUTL S IBAT=$$SL^IBATUTL Q:'IBAT
D @$S(IBAT["IBAT(351.6,":"EN^IBATLM1(+IBAT)",1:"EN^IBATLM0(+IBAT)")
S VALMBCK="Q"
Q
SP ; -- select patient and go to transaction list manager
N DA,IBVAL
D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
D EN^IBATLM1(DA),INIT^IBATLM0
Q
CF ; -- used to change a patient's enrolled facility
N DA,IBVAL
D LMOPT^IBATUTL,EN^VALM2($G(XQORNOD(0)))
S (DA,IBVAL)=0,IBVAL=$O(VALMY(IBVAL)) Q:'IBVAL
S DA=$O(@VALMAR@("INDEX",IBVAL,DA))
D CFP(DA),INIT^IBATLM0
Q
CFP(DA) ; allows entry from patient level screen to change facility
;
N DIE,DR,DTOUT
W !!,"Note: By entering a facility here, ALL future transactions for"
W !,"this patient will ALWAYS go to this facility, no matter where the"
W !,"patient's enrolled facility may be. The only way to stop this"
W !,"for future transactions is to delete the OVERRIDDEN FACILITY.",!
S DIE="^IBAT(351.6,",DR=.1 D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBATLM0A 2293 printed Apr 09, 2024@21:04:46 Page 2
IBATLM0A ;LL/ELZ - TRANSFER PRICING PT LIST LIST MANAGER ; 29-JAN-1999
+1 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
AP ; -- adding a patient
+1 NEW DIC,X,Y,DTOUT,DUOUT,%,%Y,IBFAC
+2 DO LMOPT^IBATUTL
+3 SET DIC="^DPT("
SET DIC(0)="AEMNQ"
SET DIC("S")="I '$D(^IBAT(351.6,Y,0))"
+4 DO ^DIC
if Y<1
QUIT
IF $$TPP^IBATUTL(+Y)
DO INIT^IBATLM0
QUIT
+5 WRITE !!,"Currently this patient is not listed as having a Enrolled Facility other"
+6 WRITE !,"than your own!",!!,"Do you really want to add this patient? "
+7 SET DFN=+Y
SET %=2
DO YN^DICN
if %'=1
QUIT
+8 SET IBFAC=$$ONEFAC^IBATUTL
IF IBFAC
SET IBFAC=$$PAT^IBATFILE(DFN,,IBFAC)
+9 DO INIT^IBATLM0
+10 QUIT
CS ; -- change the status of a patient
+1 NEW IBVAL,DA
+2 DO LMOPT^IBATUTL
DO EN^VALM2($GET(XQORNOD(0)))
+3 SET (DA,IBVAL)=0
SET IBVAL=$ORDER(VALMY(IBVAL))
if 'IBVAL
QUIT
+4 SET DA=$ORDER(@VALMAR@("INDEX",IBVAL,DA))
+5 DO CSP(DA)
DO INIT^IBATLM0
+6 QUIT
+7 ;
CSP(DA) ; allows entry from patient level screen to change status
+1 ;
+2 NEW DIE,DR,DTOUT
+3 SET DIE="^IBAT(351.6,"
SET DR=.04
DO ^DIE
+4 QUIT
PI ; -- patient inquiry screen
+1 NEW IBVAL,DFN
+2 DO LMOPT^IBATUTL
DO EN^VALM2($GET(XQORNOD(0)))
+3 SET (DFN,IBVAL)=0
SET IBVAL=$ORDER(VALMY(IBVAL))
if 'IBVAL
QUIT
+4 SET DFN=$ORDER(@VALMAR@("INDEX",IBVAL,DFN))
+5 DO EN^IBATLM3
+6 QUIT
+7 ;
CV ; -- change view (selection of facility or patient)
+1 NEW IBAT
DO LMOPT^IBATUTL
SET IBAT=$$SL^IBATUTL
if 'IBAT
QUIT
+2 DO @$SELECT(IBAT["IBAT(351.6,":"EN^IBATLM1(+IBAT)",1:"EN^IBATLM0(+IBAT)")
+3 SET VALMBCK="Q"
+4 QUIT
SP ; -- select patient and go to transaction list manager
+1 NEW DA,IBVAL
+2 DO LMOPT^IBATUTL
DO EN^VALM2($GET(XQORNOD(0)))
+3 SET (DA,IBVAL)=0
SET IBVAL=$ORDER(VALMY(IBVAL))
if 'IBVAL
QUIT
+4 SET DA=$ORDER(@VALMAR@("INDEX",IBVAL,DA))
+5 DO EN^IBATLM1(DA)
DO INIT^IBATLM0
+6 QUIT
CF ; -- used to change a patient's enrolled facility
+1 NEW DA,IBVAL
+2 DO LMOPT^IBATUTL
DO EN^VALM2($GET(XQORNOD(0)))
+3 SET (DA,IBVAL)=0
SET IBVAL=$ORDER(VALMY(IBVAL))
if 'IBVAL
QUIT
+4 SET DA=$ORDER(@VALMAR@("INDEX",IBVAL,DA))
+5 DO CFP(DA)
DO INIT^IBATLM0
+6 QUIT
CFP(DA) ; allows entry from patient level screen to change facility
+1 ;
+2 NEW DIE,DR,DTOUT
+3 WRITE !!,"Note: By entering a facility here, ALL future transactions for"
+4 WRITE !,"this patient will ALWAYS go to this facility, no matter where the"
+5 WRITE !,"patient's enrolled facility may be. The only way to stop this"
+6 WRITE !,"for future transactions is to delete the OVERRIDDEN FACILITY.",!
+7 SET DIE="^IBAT(351.6,"
SET DR=.1
DO ^DIE
+8 QUIT
