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

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

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

File size: 1.9 KB
Line 
1BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am
2 ;;1.4;BSDX;;Sep 07, 2010
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.