1 | A1B2MUT1 ;ALB/MJK - BILLING UTILITY ROUTINE ;16-JAN-91
|
---|
2 | ;;Version 1.55 (local for MAS v5 sites);;
|
---|
3 | ;
|
---|
4 | NONVA ; -- if displaced then ask if non-va adm is related
|
---|
5 | S A1B2PT=+$O(^A1B2(11500.1,"AD",DFN,0)),A1B2DP=0
|
---|
6 | F Y=0:0 S Y=$O(^A1B2(11500.3,"C",A1B2PT,Y)) Q:'Y I $D(^A1B2(11500.3,Y,0)),$P(^(0),U,15) S A1B2DP=Y Q
|
---|
7 | D ASK,ADM:Y
|
---|
8 | NONVAQ K A1B2PT,A1B2DP Q
|
---|
9 | ;
|
---|
10 | ASK ; -- ask if for displacement
|
---|
11 | I $D(^A1B2(11500.3,+A1B2DP,0)) S X="A1B2CT" X ^%ZOSF("TEST") I K DXS S D0=A1B2DP D ^A1B2CT K DXS
|
---|
12 | S DIR(0)="Y",DIR("A")="Was this non-VA admission ODS related",DIR("B")="NO"
|
---|
13 | S DIR("?",1)=" answer 'Yes' if admission occurred because the patient was"
|
---|
14 | S DIR("?",2)=" displaced to allow an ODS admission"
|
---|
15 | S DIR("?",3)=" "
|
---|
16 | S DIR("?",4)=" or 'No' if it was not ODS related.",DIR("?")=" "
|
---|
17 | D ^DIR K DIR
|
---|
18 | Q
|
---|
19 | ;
|
---|
20 | ADM ; -- set up vars and add entry
|
---|
21 | I 'A1B2PT D PT1^DGYZODS S A1B2PT=DGODS K DGODS G ADMQ:'A1B2PT
|
---|
22 | S A1B2ADTY=9
|
---|
23 | S A1B2SPEC="",X=+$O(^DGPT(A1B2PTF,"M","AM",0)) I $D(^DGPT(A1B2PTF,"M",+$O(^(X,0)),0)) S A1B2SPEC=$P(^(0),"^",2)
|
---|
24 | S X=A1B2ADM2 D ADM^A1B2UTL
|
---|
25 | I A1B2ADM,$D(^DGPT(A1B2PTF,70)),+^(70) S DA=A1B2ADM,DR=".06////"_+^(70),DIE="^A1B2(11500.2," D ^DIE K DIE,DR,DQ,DG,DB,DE
|
---|
26 | ADMQ K A1B2ADTY,A1B2SPEC Q
|
---|
27 | ;
|
---|