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

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

Ayman Ghaith : adding the correct routines which not has the transactions.
File size: 3.9 KB
Line 
1BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
2 ;;1.7;BSDX;;Jun 01, 2013;Build 24
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.