source: WorldVistAEHR/trunk/r/OPERATIONS_WITH_DESERT_STORM-A1B2/A1B2MAIN.m@ 1753

Last change on this file since 1753 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1A1B2MAIN ;ALB/AAS - ODS store billing data ; 17-JAN-91
2 ;;Version 1.55 (local for MAS v5 sites);;
3 ;
4 ; -- main ods billing collection program
5 ; -- Called by PTF (dgptfrel) release to store billing data
6 ;
7 ; -- input: DGPTIFN := ifn of ptf record in ^DGPT
8 ;
9MAIN ;
10 I $S('$D(DGPTIFN):1,'DGPTIFN:1,'$D(^DGPT(DGPTIFN,0)):1,$P(^(0),U,4):1,1:0) Q
11 D ON^A1B2UTL G:'A1B2ODS END
12 D FAC^A1B2UTL G:'A1B2FN END
13 S A1B2PTF=DGPTIFN D ADM^A1B2MUT G:'A1B2ADM END
14 I '$D(^A1B2(11500.2,+A1B2ADM,0)) G END
15 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))
16 S DA=A1B2ADM,DIE="^A1B2(11500.2,",DR=".2////"_A1B2PTF_";.21////"_A1B2PTFC D ^DIE K DIE,DA,DR
17SPC W !!,">>>> Storing Billable Specialties from PTF in ODS file. >>>>" D WAIT
18 I $D(^A1B2(11500.61,"C",+A1B2ADM)) S A1B2FL=11500.61 D INACT
19 D ^A1B2MSP ; file specialties and los in 11500.61
20 W !!,">>>> Storing Surgeries and Procedures in ODS files. >>>>" D WAIT,PROC
21 W !!,">>>> Storing Diagnoses in ODS files. >>>>" D WAIT,DIAG
22 W !!,"You may now enter any additional costs related to this ODS admission.",! D COST
23 G END
24 ;
25PROC ; -- find procedures and surgeries in ptf and store in 11500.62
26 ; -- find surgeries
27 I $D(^A1B2(11500.62,"C",+A1B2ADM)) S A1B2FL=11500.62 D INACT
28 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
29 ; -- find procedures
30 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
31 Q
32 ;
33PROC1 ; --set up to file procedures and surgeries
34 S A1B2FL=11500.62
35 D ADD^A1B2UTL
36 S DA=+Y,DIE="^A1B2(11500.62,",DR="[A1B2 PROCEDURE STUFF]" D ^DIE
37 Q
38DIAG ; -- find diagnosis in ptf and file in 11500.63
39 I $D(^A1B2(11500.63,"C",+A1B2ADM)) S A1B2FL=11500.63 D INACT
40 S A1B270=$S('$D(^DGPT(A1B2PTF,70)):"",1:^(70)) Q:A1B270=""
41 ; -- get dxls
42 S A1B2DT=$P(A1B270,"^",10),A1B2DXLS=1 I A1B2DT]"" D DIAG1
43 ; -- get remaining diagnoses
44 S A1B2DT="" F A1B2I=16:1:24 S A1B2DXLS="",A1B2DT=$P(A1B270,"^",A1B2I) I A1B2DT]"" D DIAG1
45 K A1B270,A1B2DT,A1B2I
46 Q
47 ;
48DIAG1 ; -- set up to file
49 S A1B2FL=11500.63
50 D ADD^A1B2UTL
51 S DA=+Y,DIE="^A1B2(11500.63,",DR="[A1B2 DIAGNOSIS STUFF]" D ^DIE
52 Q
53 ;
54COST ; -- input cost data
55 D FAC^A1B2UTL
56 I '$D(A1B2ADM) G END
57 ;
58COST1 S DIC("A")="Select COST DATE: ",DIC="^A1B2(11500.64,",DIC(0)="AEQLM" D DICDR1^A1B2MUT
59 D ^DIC Q:Y<1 K DIC S DA=+Y
60 S DIE="^A1B2(11500.64,",DR="[A1B2 ENTRY]" ;I '$P(Y,"^",3),$D(^A1B2(11500.64,DA,1)),+^(1)'=2
61 D ^DIE
62 W ! G COST1
63 Q
64 ;
65END K A1B2DXLS,A1B2J,A1B2PDT,D0,C,A1B2X,A1B2FL,A1B2ADM1,A1B2ADM,A1B2PTF,A1B2PTFC,A1B2ODS,DIC,DIE,DA,DR,Y,X
66 I '$D(A1B2NTY) K A1B2FN,A1B2FNME
67 Q
68WAIT ;
69 W !,"..."
70 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)_"..."
71 Q
72 ;
73INACT ; -- inactivate existing entries prior to re-running
74 S A1B2X=0,DR=".15////0;1.01////3",DIE=A1B2FL
75 F A1B2I=0:0 S A1B2X=$O(^A1B2(A1B2FL,"C",+A1B2ADM,A1B2X)) Q:'A1B2X S DA=A1B2X D ^DIE
76 K A1B2FL,DIE,DA,DR Q
Note: See TracBrowser for help on using the repository browser.