- 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 Mar 13, 2025@21:12:39 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
