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

Last change on this file since 760 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package
File size: 3.4 KB
Line 
1BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
2 ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;
5ERROR ;
6 D ERR("RPMS Error")
7 Q
8 ;
9ERR(BSDXERR) ;Error processing
10 S BSDXI=BSDXI+1
11 S ^BSDXTMP($J,BSDXI)=$C(31)
12 Q
13 ;
14HOSPLOCD(BSDXY) ;EP Debugging entry point
15 ;
16 ;D DEBUG^%Serenji("HOSPLOC^BSDX32(.BSDXY)")
17 ;
18 Q
19 ;
20HOSPLOC(BSDXY) ;EP
21 ;Called by BSDX HOSPITAL LOCATION
22 ;
23 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD
24 D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
25 K ^BSDXTMP($J)
26 S BSDXY="^BSDXTMP("_$J_")"
27 S BSDXI=0
28 ;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION";
29 S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE"_$C(30)
30 ;
31 S BSDXNAM="" F S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM="" D
32 . S BSDXIEN=$O(^SC("B",BSDXNAM,0))
33 . Q:'+BSDXIEN>0
34 . Q:'$D(^SC(+BSDXIEN,0))
35 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
36 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
37 . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date
38 . S BSDXNOD=^SC(BSDXIEN,0)
39 . S BSDXNAM=$P(BSDXNOD,U)
40 . S BSDXSCOD=$$GET1^DIQ(44,BSDXIEN_",",8) ;STOP CODE
41 . ;Calculate default provider
42 . S BSDXPRV=""
43 . I $D(^SC(BSDXIEN,"PR")) D
44 . . S BSDXIEN1=0 F S BSDXIEN1=$O(^SC(BSDXIEN,"PR",BSDXIEN1)) Q:'+BSDXIEN1 Q:BSDXPRV]"" D
45 . . . S BSDXNOD1=$G(^SC(BSDXIEN,"PR",BSDXIEN1,0))
46 . . . S:$P(BSDXNOD1,U,2)="1" BSDXPRV=$$GET1^DIQ(200,$P(BSDXNOD1,U),.01)
47 . . . Q
48 . . Q
49 . S BSDXI=BSDXI+1
50 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_$C(30)
51 . Q
52 S BSDXI=BSDXI+1
53 S ^BSDXTMP($J,BSDXI)=$C(31)
54 Q
55 ;
56CLNSETD(BSDXY) ;EP Debugging entry point
57 ;
58 ;D DEBUG^%Serenji("CLNSET^BSDX32(.BSDXY)")
59 ;
60 Q
61 ;
62CLNSET(BSDXY) ;EP
63 ;Called by BSDX CLINIC SETUP
64 ;Returns CLINIC SETUP file entries for clinics which
65 ;are active in ^SC
66 N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA
67 N BSDXCRV,BSDXVSC,BSDXMULT,BSDXREQ,BSDXPCC
68 D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
69 K ^BSDXTMP($J)
70 S BSDXY="^BSDXTMP("_$J_")"
71 S BSDXI=0
72 ;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,
73 ;GENERATE_PCCPLUS_FORMS? FROM CLINIC_SETUP_PARAMETERS
74 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)
75 ;
76 S BSDXIEN=0 F S BSDXIEN=$O(^BSDSC(BSDXIEN)) Q:'+BSDXIEN D
77 . Q:'$D(^SC(+BSDXIEN,0))
78 . Q:'$D(^BSDSC(+BSDXIEN,0))
79 . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
80 . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
81 . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date
82 . S BSDXNOD=^BSDSC(BSDXIEN,0)
83 . S BSDXNAM=$$GET1^DIQ(44,BSDXIEN_",",.01)
84 . S BSDXCRV=$$GET1^DIQ(9009017.2,BSDXIEN_",",.09)
85 . S BSDXVSC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.12)
86 . S BSDXMULT=$$GET1^DIQ(9009017.2,BSDXIEN_",",.13)
87 . S BSDXREQ=$$GET1^DIQ(9009017.2,BSDXIEN_",",.14)
88 . S BSDXPCC=$$GET1^DIQ(9009017.2,BSDXIEN_",",.15)
89 . S BSDXI=BSDXI+1
90 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXCRV_U_BSDXVSC_U_BSDXMULT_U_BSDXREQ_U_BSDXPCC_$C(30)
91 . Q
92 S BSDXI=BSDXI+1
93 S ^BSDXTMP($J,BSDXI)=$C(31)
94 Q
Note: See TracBrowser for help on using the repository browser.