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

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.

File size: 1.8 KB
RevLine 
[1161]1BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am
[1187]2 ;;1.6T2;BSDX;;May 16, 2011
[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 ;
20 D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
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
[803]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.