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

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 3.9 KB
Line 
1BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
2 ;;1.6T2;BSDX;;May 16, 2011
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.