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

Last change on this file since 1472 was 1472, checked in by Sam Habiel, 12 years ago

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.

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