| 1 | IBTRKR0 ;ALB/AAS - CLAIMS TRACKING - RANDOM SELECTION BULLETIN ; 13-AUG-93
 | 
|---|
| 2 |  ;;Version 2.0 ; INTEGRATED BILLING ;**23**; 21-MAR-94
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | BULL ; -- send bulletin
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  S XMSUB="UR Random Sample Patient Selection"
 | 
|---|
| 7 |  S IBT(1)="The following Patient has been selected as a UR Random Sample case on "
 | 
|---|
| 8 |  S IBT(1.1)=$$DAT2^IBOUTL($$NOW^XLFDT())_"."
 | 
|---|
| 9 |  S IBT(1.2)=""
 | 
|---|
| 10 |  S IBT(2)="        Patient: "_$P(^DPT(DFN,0),"^")
 | 
|---|
| 11 |  D PID^VADPT
 | 
|---|
| 12 |  S IBT(3)="         Pt. ID: "_VA("PID")
 | 
|---|
| 13 |  S IBT(4)=" Admission Date: "_$P(VAIN(7),"^",2)_"   ("_VAIN(1)_")"
 | 
|---|
| 14 |  S IBT(4.1)="    CT Entry ID: "_$P($G(^IBT(356,+IBTRN,0)),"^")
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  S IBT(4.5)=""
 | 
|---|
| 17 |  S IBT(5)="      Specialty: "_$P(VAIN(3),"^",2)
 | 
|---|
| 18 |  S SVC=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+VAIN(3),0)),"^",2),0)),"^",3)
 | 
|---|
| 19 |  S IBT(6)="        Service: "_$$EXPAND^IBTRE(42.4,3,SVC)
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  S IBT(7)=""
 | 
|---|
| 22 |  S IBT(9)="  Ward Location: "_$S($D(^DIC(42,+$P(DGPMA,"^",6),0)):$P(^(0),"^",1),1:"UNKNOWN")
 | 
|---|
| 23 |  S IBT(10)="       Room-Bed: "_$S($D(^DG(405.4,+$P(DGPMA,"^",7),0)):$P(^(0),"^",1),1:"UNKNOWN")
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 |  S IBT(11)="   Admitting DX: "_$P(DGPMA,"^",10)
 | 
|---|
| 26 |  S IBT(12)="  Type of Admit: "_$S($D(^DG(405.1,+$P(DGPMA,"^",4),0)):$P(^(0),"^",1),1:"")
 | 
|---|
| 27 |  S IBT(13)=""
 | 
|---|
| 28 |  S IBT(14)="        Insured: "_$S($$INSURED^IBCNS1(DFN):"YES",1:"NO")
 | 
|---|
| 29 |  D SEND
 | 
|---|
| 30 | BULLQ Q
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 | SEND S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT("
 | 
|---|
| 33 |  K XMY S XMN=0
 | 
|---|
| 34 |  S DGPMX=$O(^XMB(3.8,"B","DGPM UR ADMISSION",0)) I '$O(^XMB(3.8,+DGPMX,1,0)) G SENDQ ; if no mailgroup members, quit
 | 
|---|
| 35 |  S XMY("G.DGPM UR ADMISSION")="" ; pass mailgroup
 | 
|---|
| 36 |  D ^XMD
 | 
|---|
| 37 | SENDQ K X,Y,IBI,IBT,IBGRP,XMDUZ,XMTEXT,XMY,XMSUB,DGPMX
 | 
|---|
| 38 |  Q
 | 
|---|