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
RevLine 
[951]1BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am
2 ;;1.4;BSDX;;Sep 07, 2010
[803]3 ;
4 ;
5ERROR ;
6 D ERR("RPMS Error")
7 Q
8 ;
9ERR(BSDXERR) ;Error processing
[888]10 D ^%ZTER
[803]11 S BSDXI=BSDXI+1
[888]12 S ^BSDXTMP($J,BSDXI)=BSDXERR
13 S BSDXI=BSDXI+1
[803]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 ;
[888]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
[803]30 ; Called by BSDX HOSP LOC PROVIDERS
31 ;
32 S BSDXI=0
[888]33 I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
[803]34 D ^XBKVAR
[888]35 N $ET S $ET="G ERROR^BSDXGPRV"
[803]36 K ^BSDXTMP($J)
37 S BSDXY=$NA(^BSDXTMP($J))
38 S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID"
[888]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)
[803]43 ;
[888]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)
[803]57 S BSDXI=BSDXI+1
58 S ^BSDXTMP($J,BSDXI)=$C(31)
59 QUIT
Note: See TracBrowser for help on using the repository browser.