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

A1B2MAIN.m

Go to the documentation of this file. 
  1. A1B2MAIN ;ALB/AAS - ODS store billing data ; 17-JAN-91
  1.  ;;Version 1.55 (local for MAS v5 sites);;
  1.  ;
  1.  ;  -- main ods billing collection program
  1.  ;  -- Called by PTF  (dgptfrel)   release to store billing data
  1.  ;
  1.  ;  -- input:    DGPTIFN := ifn of ptf record in ^DGPT
  1.  ;
  1. MAIN ;
  1.  I $S('$D(DGPTIFN):1,'DGPTIFN:1,'$D(^DGPT(DGPTIFN,0)):1,$P(^(0),U,4):1,1:0) Q
  1.  D ON^A1B2UTL G:'A1B2ODS END
  1.  D FAC^A1B2UTL G:'A1B2FN END
  1.  S A1B2PTF=DGPTIFN D ADM^A1B2MUT G:'A1B2ADM END
  1.  I '$D(^A1B2(11500.2,+A1B2ADM,0)) G END
  1.  S A1B2PTFC=$S('$P(^DGPT(DGPTIFN,0),"^",9):DT,'$D(^DGP(45.84,$P(^(0),"^",9),0)):DT,'$P(^(0),"^",2):DT,1:$P(^(0),"^",2))
  1.  S DA=A1B2ADM,DIE="^A1B2(11500.2,",DR=".2////"_A1B2PTF_";.21////"_A1B2PTFC D ^DIE K DIE,DA,DR
  1. SPC W !!,">>>> Storing Billable Specialties from PTF in ODS file. >>>>" D WAIT
  1.  I $D(^A1B2(11500.61,"C",+A1B2ADM)) S A1B2FL=11500.61 D INACT
  1.  D ^A1B2MSP ; file specialties and los in 11500.61
  1.  W !!,">>>> Storing Surgeries and Procedures in ODS files. >>>>" D WAIT,PROC
  1.  W !!,">>>> Storing Diagnoses in ODS files. >>>>" D WAIT,DIAG
  1.  W !!,"You may now enter any additional costs related to this ODS admission.",! D COST
  1.  G END
  1.  ;
  1. PROC ;  -- find procedures and surgeries in ptf and store in 11500.62
  1.  ;  -- find surgeries
  1.  I $D(^A1B2(11500.62,"C",+A1B2ADM)) S A1B2FL=11500.62 D INACT
  1.  S A1B2EDT=0 F A1B2I=0:0 S A1B2EDT=$O(^DGPT(A1B2PTF,"S",A1B2EDT)) Q:'A1B2EDT  I $D(^DGPT(A1B2PTF,"S",A1B2EDT,0)) S A1B2X=^(0),A1B2PDT=+A1B2X F A1B2J=8:1:12 S A1B2DT=$P(A1B2X,"^",A1B2J) D:A1B2DT]"" PROC1
  1.  ;  -- find procedures
  1.  S A1B2EDT=0 F A1B2I=0:0 S A1B2EDT=$O(^DGPT(A1B2PTF,"P",A1B2EDT)) Q:'A1B2EDT  I $D(^DGPT(A1B2PTF,"P",A1B2EDT,0)) S A1B2X=^(0),A1B2PDT=+A1B2X F A1B2J=5:1:9 S A1B2DT=$P(A1B2X,"^",A1B2J) D:A1B2DT]"" PROC1
  1.  Q
  1.  ;
  1. PROC1 ;  --set up to file procedures and surgeries
  1.  S A1B2FL=11500.62
  1.  D ADD^A1B2UTL
  1.  S DA=+Y,DIE="^A1B2(11500.62,",DR="[A1B2 PROCEDURE STUFF]" D ^DIE
  1.  Q
  1. DIAG ;  -- find diagnosis in ptf and file in 11500.63
  1.  I $D(^A1B2(11500.63,"C",+A1B2ADM)) S A1B2FL=11500.63 D INACT
  1.  S A1B270=$S('$D(^DGPT(A1B2PTF,70)):"",1:^(70)) Q:A1B270=""
  1.  ;  -- get dxls
  1.  S A1B2DT=$P(A1B270,"^",10),A1B2DXLS=1 I A1B2DT]"" D DIAG1
  1.  ;  -- get remaining diagnoses
  1.  S A1B2DT="" F A1B2I=16:1:24 S A1B2DXLS="",A1B2DT=$P(A1B270,"^",A1B2I) I A1B2DT]"" D DIAG1
  1.  K A1B270,A1B2DT,A1B2I
  1.  Q
  1.  ;
  1. DIAG1 ;  -- set up to file
  1.  S A1B2FL=11500.63
  1.  D ADD^A1B2UTL
  1.  S DA=+Y,DIE="^A1B2(11500.63,",DR="[A1B2 DIAGNOSIS STUFF]" D ^DIE
  1.  Q
  1.  ;
  1. COST ;  -- input cost data
  1.  D FAC^A1B2UTL
  1.  I '$D(A1B2ADM) G END
  1.  ;
  1. COST1 S DIC("A")="Select COST DATE: ",DIC="^A1B2(11500.64,",DIC(0)="AEQLM" D DICDR1^A1B2MUT
  1.  D ^DIC Q:Y<1  K DIC S DA=+Y
  1.  S DIE="^A1B2(11500.64,",DR="[A1B2 ENTRY]" ;I '$P(Y,"^",3),$D(^A1B2(11500.64,DA,1)),+^(1)'=2
  1.  D ^DIE
  1.  W ! G COST1
  1.  Q
  1.  ;
  1. END K A1B2DXLS,A1B2J,A1B2PDT,D0,C,A1B2X,A1B2FL,A1B2ADM1,A1B2ADM,A1B2PTF,A1B2PTFC,A1B2ODS,DIC,DIE,DA,DR,Y,X
  1.  I '$D(A1B2NTY) K A1B2FN,A1B2FNME
  1.  Q
  1. WAIT ;
  1.  W !,"..."
  1.  W $P("HMMM^EXCUSE ME^SORRY","^",$R(3)+1),", ",$P("THIS MAY TAKE A FEW MOMENTS^LET ME PUT YOU ON 'HOLD' FOR A SECOND^HOLD ON^JUST A MOMENT PLEASE^I'M WORKING AS FAST AS I CAN^LET ME THINK ABOUT THAT A MOMENT","^",$R(6)+1)_"..."
  1.  Q
  1.  ;
  1. INACT ;  -- inactivate existing entries prior to re-running
  1.  S A1B2X=0,DR=".15////0;1.01////3",DIE=A1B2FL
  1.  F A1B2I=0:0 S A1B2X=$O(^A1B2(A1B2FL,"C",+A1B2ADM,A1B2X)) Q:'A1B2X  S DA=A1B2X D ^DIE
  1.  K A1B2FL,DIE,DA,DR Q