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

Last change on this file since 1575 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

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