source: Scheduling/trunk/m/BSDXGPRV.m@ 855

Last change on this file since 855 was 803, checked in by Sam Habiel, 14 years ago

New Routine BSDXGPRV to get providers associated with hospital location

File size: 1.9 KB
RevLine 
[803]1BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 6/10/10 9:01pm
2 ;;1.1;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;
5ERROR ;
6 D ERR("RPMS Error")
7 Q
8 ;
9ERR(BSDXERR) ;Error processing
10 D ^%ZTER
11 S BSDXI=BSDXI+1
12 S ^BSDXTMP($J,BSDXI)=BSDXERR
13 S BSDXI=BSDXI+1
14 S ^BSDXTMP($J,BSDXI)=$C(31)
15 Q
16 ;
17PD(BSDXY,HLIEN) ;EP Debugging entry point
18 ;
19 D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
20 ;
21 Q
22 ;
23P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
24 ; Input: HLIEN - Hospital Location IEN
25 ; Output: ADO Datatable with columns:
26 ; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT
27 ; If there are providers in the PROVIDER multiple of file 44
28 ; (Hospital Location) return them;
29 ; If no providers in PROVIDER multiple of file 44, return nothing
30 ; Called by BSDX HOSP LOC PROVIDERS
31 ;
32 S BSDXI=0
33 I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
34 D ^XBKVAR
35 N $ET S $ET="G ERROR^BSDXGPRV"
36 K ^BSDXTMP($J)
37 S BSDXY=$NA(^BSDXTMP($J))
38 S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID"
39 S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN"
40 S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME"
41 S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT"
42 S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
43 ;
44 N OUTPUT
45 D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple
46 ; No results
47 I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT
48 ; if results, get them
49 N I S I=""
50 F S I=$O(OUTPUT(44.1,I)) Q:I="" D
51 . S BSDXI=BSDXI+1
52 . S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN ; HL IEN
53 . S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN
54 . S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME
55 . S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO
56 . S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
57 S BSDXI=BSDXI+1
58 S ^BSDXTMP($J,BSDXI)=$C(31)
59 QUIT
Note: See TracBrowser for help on using the repository browser.