| 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 | ; | 
|---|