source: Scheduling/trunk/m/BSDX32.m@ 1176

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

Merging Radiology Support branch back to trunk.

File size: 3.8 KB
Line 
1BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am
2 ;;1.5;BSDX;;Apr 28, 2011
3 ; Licensed under LGPL
4 ;
5 ;
6ERROR ;
7 D ERR("RPMS Error")
8 Q
9 ;
10ERR(BSDXERR) ;Error processing
11 S BSDXI=BSDXI+1
12 S ^BSDXTMP($J,BSDXI)=$C(31)
13 Q
14 ;
15HOSPLOCD(BSDXY) ;EP Debugging entry point
16 ;
17 ;D DEBUG^%Serenji("HOSPLOC^BSDX32(.BSDXY)")
18 ;
19 Q
20 ;
21HOSPLOC(BSDXY) ;EP
22 ;Called by BSDX HOSPITAL LOCATION
23 ;Returns all hospital locations that are active
24 ;
25 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD
26 D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
27 K ^BSDXTMP($J)
28 S BSDXY="^BSDXTMP("_$J_")"
29 S BSDXI=0
30 ;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION";
31 S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00001IS_RADIOLOGY_LOCATION"_$C(30)
32 ;
33 S BSDXNAM="" F S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM="" D
34 . S BSDXIEN=$O(^SC("B",BSDXNAM,0))
35 . Q:'+BSDXIEN>0
36 . Q:'$D(^SC(+BSDXIEN,0))
37 . ;Q:'$$INDIV^BSDX01(+BSDXIEN) ; if not in the same division, quit
38 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
39 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
40 . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date
41 . S BSDXNOD=^SC(BSDXIEN,0)
42 . S BSDXNAM=$P(BSDXNOD,U)
43 . S BSDXSCOD=$$GET1^DIQ(44,BSDXIEN_",",8) ;STOP CODE
44 . ;Calculate default provider
45 . S BSDXPRV=""
46 . I $D(^SC(BSDXIEN,"PR")) D
47 . . S BSDXIEN1=0 F S BSDXIEN1=$O(^SC(BSDXIEN,"PR",BSDXIEN1)) Q:'+BSDXIEN1 Q:BSDXPRV]"" D
48 . . . S BSDXNOD1=$G(^SC(BSDXIEN,"PR",BSDXIEN1,0))
49 . . . S:$P(BSDXNOD1,U,2)="1" BSDXPRV=$$GET1^DIQ(200,$P(BSDXNOD1,U),.01)
50 . . . Q
51 . . Q
52 . ; Decide if this is a radiology location - Check "B" index of ^RA(79.1 global to see if HL is there
53 . N BSDXISRAD S BSDXISRAD=''$DATA(^RA(79.1,"B",BSDXIEN))
54 . S BSDXI=BSDXI+1
55 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_U_BSDXISRAD_$C(30)
56 . Q
57 S BSDXI=BSDXI+1
58 S ^BSDXTMP($J,BSDXI)=$C(31)
59 Q
60 ;
61CLNSETD(BSDXY) ;EP Debugging entry point
62 ;
63 ;D DEBUG^%Serenji("CLNSET^BSDX32(.BSDXY)")
64 ;
65 Q
66 ;
67CLNSET(BSDXY) ;EP
68 ;Called by BSDX CLINIC SETUP
69 ;Returns CLINIC SETUP file entries for clinics which
70 ;are active in ^SC
71 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA
72 N BSDXCRV,BSDXVSC,BSDXMULT,BSDXREQ,BSDXPCC
73 D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
74 K ^BSDXTMP($J)
75 S BSDXY="^BSDXTMP("_$J_")"
76 S BSDXI=0
77 ;SELECT BMXIEN 'HOSPITAL_LOCATION_ID', CLINIC_NAME 'HOSPITAL_LOCATION', CREATE_VISIT_AT_CHECK-IN? 'CREATE_VISIT', VISIT_SERVICE_CATEGORY, MULTIPLE_CLINIC_CODES_USED?, VISIT_PROVIDER_REQUIRED,
78 ;GENERATE_PCCPLUS_FORMS? FROM CLINIC_SETUP_PARAMETERS
79 S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030CREATE_VISIT^T00030VISIT_SERVICE_CATEGORY^T00030MULTIPLE_CLINIC_CODES_USED?^T00030VISIT_PROVIDER_REQUIRED^T00030GENERATE_PCCPLUS_FORMS?"_$C(30)
80 ;
81 S BSDXIEN=0 F S BSDXIEN=$O(^BSDSC(BSDXIEN)) Q:'+BSDXIEN D
82 . Q:'$D(^SC(+BSDXIEN,0))
83 . Q:'$D(^BSDSC(+BSDXIEN,0))
84 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
85 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
86 . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date
87 . S BSDXNOD=^BSDSC(BSDXIEN,0)
88 . S BSDXNAM=$$GET1^DIQ(44,BSDXIEN_",",.01)
89 . S BSDXCRV=$$GET1^DIQ(9009017.2,BSDXIEN_",",.09)
90 . S BSDXVSC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.12)
91 . S BSDXMULT=$$GET1^DIQ(9009017.2,BSDXIEN_",",.13)
92 . S BSDXREQ=$$GET1^DIQ(9009017.2,BSDXIEN_",",.14)
93 . S BSDXPCC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.15)
94 . S BSDXI=BSDXI+1
95 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXCRV_U_BSDXVSC_U_BSDXMULT_U_BSDXREQ_U_BSDXPCC_$C(30)
96 . Q
97 S BSDXI=BSDXI+1
98 S ^BSDXTMP($J,BSDXI)=$C(31)
99 Q
Note: See TracBrowser for help on using the repository browser.