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

IBODIV.m

Go to the documentation of this file. 
  1. IBODIV	;BSN/GRR - MULTI-DIVISION SELECT ; 27 FEB 84  9:40 am
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;
  1. 	; -- copied for scheduling v5.3 routine SDDIV
  1. 	;
  1. ROUT	S DIC("A")="ROUTING SLIPS FOR WHICH DIVISION: " G ASK
  1. APLST	S DIC("A")="APPOINTMENT LIST FOR WHICH DIVISION: " G ASK
  1. FRLST	S DIC("A")="FILE ROOM LIST FOR WHICH DIVISION: " G ASK
  1. CLST	S DIC("A")="CLINIC LIST FOR WHICH DIVISION: " G ASK
  1. PALST	S DIC("A")="PRE-APPOINTMENT LETTERS FOR WHICH DIVISION: " G DIC
  1. CNLET	S DIC("A")="CANCELLATION LETTERS FOR WHICH DIVISION: " G DIC
  1. PCNLET	S DIC("A")="APPOINTMENT CANCELLATION LETTERS FOR WHICH DIVISION: " G DIC
  1. NSLET	S DIC("A")="NO-SHOW LETTERS/AUTO REBOOK REPORT FOR WHICH DIVISION: " G ASK
  1. NSLET1	S DIC("A")="NO-SHOW LETTERS FOR WHICH DIVISION: " G DIC
  1. RALST	S DIC("A")="RADIOLOGY LIST FOR WHICH DIVISION: " G ASK
  1. A223	S DIC("A")="AMIS SEGMENT 223 FOR WHICH DIVISION: " G ASK
  1. CSSD	S DIC("A")="CREATE SURVEY DISPOSITIONING RECORDS FOR WHICH DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): " G ASK
  1. SDCP	S DIC("A")="CLINIC PROFILES FOR WHICH DIVISION: " G ASK
  1. DSSA	S DIC("A")="DISPOSITION SURVEY APPOINTMENTS FOR WHICH DIVISION: " G ASK
  1. PSDR	S DIC("A")="DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): " G ASK2
  1. CSEE	S DIC("A")="ENTER VISIT DATA FOR WHICH DIVISION: " G ASK
  1. CALST	S DIC("A")="CLINIC ASSIGNMENT LIST FOR WHICH DIVISION: " G ASK
  1. CACTLST	S DIC("A")="CLINIC WORKLOAD LIST FOR WHICH DIVISION: " G ASK
  1. 	Q
  1. 	;
  1. ASK	S ALL=0,SDEF=$N(^DG(40.8,0)) G:'$D(^(SDEF,0)) ERR W !,DIC("A")," ",$P(^(0),"^"),"// " R X:DTIME I X["^" G ERR
  1. 	I X="ALL" S ALL=1 I $D(SDALL),'SDALL S X="?",ALL=0 W *7," ??"
  1. 	S:X="" DIV=SDEF G:X=""!(X="ALL") AWAY S DIC="^DG(40.8,",DIC(0)="EQMN" I X["?",$S('$D(SDALL):1,SDALL:1,1:0) W "    Enter 'ALL' for all divisions or"
  1. DIC	D ^DIC G:X["?"!((Y<0)&('$D(SDLT))) ASK Q:$D(SDLT)&(Y'>0)  S:$D(SDLT) SDV1=+Y S DIV=+Y K DIC Q
  1. AWAY	S Y=1 K DIC,SDEF Q
  1. ERR	S Y=-1 K DIC,SDALL,SDEF Q
  1. ASK2	S (VAUTD,Y)=0 I '$D(^DG(40.8,$N(^DG(40.8,0)),0)) W !,*7,"***WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP" G ERR
  1. 	I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) G DIVISION^VAUTOMA
  1. 	S I=$N(^DG(40.8,0)) G:'$D(^DG(40.8,I,0)) ERR S VAUTD(I)=$P(^(0),U) K DIC Q