Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBEMTF

IBEMTF.m

Go to the documentation of this file. 
  1. IBEMTF ;ALB/CPM - FLAG STOP CODES, DISPOSITIONS, AND CLINICS ; 22-JUL-93
  1.  ;;2.0;INTEGRATED BILLING;**167**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. EN ; Option entry point - main processing loop.
  1.  ;
  1.  ; per patch ib*2*167, this option no longer valid
  1.  ;
  1.  W !!,"Due to the new Means Test Copayment Tier, this option, is no longer used!",!!
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT S DIR(0)="E" D ^DIR
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1.  S IBQ=0 F  D UPD Q:IBQ
  1.  K IBQ
  1.  Q
  1.  ;
  1. UPD ; Update the billable status for stop codes, dispositions, or clinics.
  1.  W @IOF,*13,?6,"Flag Stop Codes, Dispositions, and Clinics for Means Test Billing"
  1.  W !,$$DASH(),!,"This option is used to set up Clinic Stop Codes, Dispositions, and Clinics"
  1.  W !,"as either non-billable or billable for the Means Test Outpatient Copayment."
  1.  W !!,"Use of this option will have an immediate effect on your billing operations,"
  1.  W !,"so you should have your work pre-planned before using this option.",!,$$DASH()
  1.  ;
  1.  ; - select stop codes, dispositions, or clinics.
  1.  S DIR(0)="SO^S:STOP CODES;D:DISPOSITIONS;C:CLINICS",DIR("?")="^D HSEL^IBEMTF1"
  1.  S DIR("A")="Enter your choice" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) G UPDQ
  1.  S IBINFO=$T(@Y+1)
  1.  ;
  1.  ; - some help
  1.  W !!,$$DASH(),!,"You may now enter the ",$P(IBINFO,";",3)," that you wish to flag.  Please note"
  1.  W !,"all ",$P(IBINFO,";",3)," that you select will be assigned the same effective"
  1.  W !,"date and billable status.",!,$$DASH(),!
  1.  ;
  1.  ; - select all entries to be updated
  1.  S (IBNUM,IBHIT)=0 D UPDQ1 F  D  Q:Y<0
  1.  .S DIC=$P(IBINFO,";",5),DIC(0)="QEAMZ"
  1.  .S DIC("A")=$S(IBHIT:"Next",1:"Select")_" "_$P(IBINFO,";",4)_": "
  1.  .S:$P(IBINFO,";",6)]"" DIC("S")=$P(IBINFO,";",6)
  1.  .D ^DIC K DIC Q:Y<0  S IBHIT=1
  1.  .I $D(^TMP("IBEMTF",$J,+Y)) W !,"Please note that you've already selected ",Y(0,0),"."
  1.  .E  S ^TMP("IBEMTF",$J,+Y)=Y(0,0),IBNUM=IBNUM+1
  1.  ;
  1.  ; - quit if no selections were made.
  1.  I '$D(^TMP("IBEMTF",$J)) W !!,"No ",$P(IBINFO,";",3)," selected!" S IBQ=1 G UPDQ
  1.  ;
  1.  ; - allow review of the selections.
  1.  I IBNUM>1 D REV^IBEMTF1 I IBQ G UPDQ
  1.  ;
  1.  ; - quit if all entries were de-selected (but allow re-start).
  1.  I '$D(^TMP("IBEMTF",$J)) W !!,"All ",$P(IBINFO,";",3)," were de-selected!" G UPDQ
  1.  ;
  1.  ; - should Means Test billing be ignored or activated?
  1.  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))
  1.  S DIR("?")="^D HACT^IBEMTF1"
  1.  W ! D ^DIR K DIR G:($D(DIRUT))!($D(DUOUT)) UPDQ
  1.  S IBFILE=+Y,IBACT=$S(IBFILE:"ignore",1:"activate")
  1.  ;
  1.  ; - what is the effective date for this action?
  1.  S %DT="AEX",%DT("A")="Please enter the effective date to "_IBACT_" billing: "
  1.  D ^%DT K %DT G:Y<0 UPDQ S IBDAT=Y
  1.  I Y>DT W !!,"Please note that you've selected a future date!"
  1.  ;
  1.  ; - re-display the list of selected entries.
  1.  W !!,"Action to take => ",IBACT," billing for the following ",$P(IBINFO,";",3),":" D LIST^IBEMTF1 W !
  1.  ;
  1.  ; - okay to proceed and file entries?
  1.  S DIR(0)="Y",DIR("A")="Is it okay to proceed and file these entries"
  1.  S DIR("?")="Enter 'Y' to file these entries, 'N' to try again, or '^' to quit."
  1.  D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G UPDQ
  1.  ;
  1.  ; - file selected entries.
  1.  W !!,"Filing these ",$P(IBINFO,";",4)," entries...  " D FILE^IBEMTF1
  1.  W ! S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT
  1.  ;
  1. UPDQ S:$D(DIRUT)!($D(DUOUT)) IBQ=1
  1.  K DIRUT,DUOUT,DTOUT,DIROUT,IBINFO,IBNUM,IBFILE,IBACT,IBDAT,IBHIT
  1. UPDQ1 K ^TMP("IBEMTF",$J)
  1.  Q
  1.  ;
  1. DASH() ; Write a dashed line.
  1.  Q $TR($J("",79)," ","=")
  1.  ;
  1. INFO ; Description of stop/disposition/clinic information listed below.
  1.  ;;desc (plural);desc (selection);source file root;source screen;desc (sing);dest file root;dest file #
  1.  ;
  1. S ; Stop Code Information
  1.  ;;clinic stop codes;CLINIC STOP CODE;^DIC(40.7,;I '$P(^(0),U,3);clinic stop code;^IBE(352.3,;352.3
  1.  ;
  1. D ; Disposition Information
  1.  ;;dispositions;DISPOSITION;^DIC(37,;I '$P(^(0),U,10);disposition;^IBE(352.2,;352.2
  1.  ;
  1. C ; Clinic Information
  1.  ;;clinics;CLINIC;^SC(;I $P(^(0),U,3)="C";clinic;^IBE(352.4,;352.4
  1.  ;