source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBYBPRE.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1IBYBPRE ;ALB/ARH - PATCH IB*2*27 ENVIRONMENT CHECK ; 10-FEB-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**27**; 21-MAR-94
3 ;
4EN ; Perform checks to be sure IB*2*27 can be installed.
5 ;
6 W ! S IBQ=0
7 ;
8 D CHKUSR I IBQ G ENQ ; check DUZ and DUZ(0)
9 ;
10 I $$RERUN() G ENQ ; skip checks if it appears init is being re-run
11 ;
12 D CHKAR ; make sure patch PRCA*4*15 or PRCA*4.5*1 is installed
13 D CHKIB ; make sure IB parameters are in place
14 ;
15 I IBQ K DIFQ ; stop the install if there is a problem
16 ;
17ENQ K IBQ
18 Q
19 ;
20 ;
21CHKUSR ; Check DUZ and DUZ(0).
22 I $S('($D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,'$D(DUZ(0)):1,1:0) D
23 .W !!?3,"The variable DUZ must be set to an active user code and the variable"
24 .W !?3,"DUZ(0) must also be defined to run this initialization.",!
25 .K DIFQ S IBQ=1
26 Q
27 ;
28CHKAR ; Make sure patch PRCA*4*15 or PRCA*4.5*1 is properly installed.
29 S IBCTPN="CHAMPVA THIRD PARTY",IBCTP=$O(^PRCA(430.2,"B",IBCTPN,0))
30 S IBCCVN="CHAMPVA",IBCCV=$O(^PRCA(430.2,"B",IBCCVN,0))
31 S IBCCSN="CHAMPVA SUBSISTENCE",IBCCS=$O(^PRCA(430.2,"B",IBCCSN,0))
32 ;
33 S IBCTPD=$G(^PRCA(430.2,+IBCTP,0)) I IBCTPD="" S IBQ=1 W !," >> ACCOUNTS RECEIVABLE CATEGORY (430.2) '",IBCTPN,"' not found."
34 S IBCCVD=$G(^PRCA(430.2,+IBCCV,0)) I IBCCVD="" S IBQ=1 W !," >> ACCOUNTS RECEIVABLE CATEGORY (430.2) '",IBCCVN,"' not found."
35 S IBCCSD=$G(^PRCA(430.2,+IBCCS,0)) I IBCCSD="" S IBQ=1 W !," >> ACCOUNTS RECEIVABLE CATEGORY (430.2) '",IBCCSN,"' not found."
36 ;
37 I IBQ D
38 .W !!,*7,"Patch PRCA*4*15 or PRCA*4.5*1 does not appear to be installed! Please install"
39 .W !,"the appropriate patch and then re-run this initialization."
40 ;
41 K IBCTPN,IBCTPD,IBCCVN,IBCCVD,IBCCSN,IBCCSD
42 Q
43 ;
44CHKIB ; Make sure IB parameters exist and haven't been modified.
45 S IBRTPN="CHAMPVA REIMB. INS.",IBRTP=$O(^DGCR(399.3,"B",IBRTPN,0))
46 S IBRCVN="CHAMPVA",IBRCV=$O(^DGCR(399.3,"B",IBRCVN,0))
47 ;
48 S IBACNN="DG CHAMPVA PER DIEM NEW",IBACN=$O(^IBE(350.1,"B",IBACNN,0))
49 S IBACCN="DG CHAMPVA PER DIEM CANCEL",IBACC=$O(^IBE(350.1,"B",IBACCN,0))
50 S IBACUN="DG CHAMPVA PER DIEM UPDATE",IBACU=$O(^IBE(350.1,"B",IBACUN,0))
51 ;
52 S IBRTPD=$G(^DGCR(399.3,+IBRTP,0)) I IBRTPD="" S IBQ=1 W !," >> RATE TYPE (399.3) '",IBRTPN,"' not found."
53 S IBRCVD=$G(^DGCR(399.3,+IBRCV,0)) I IBRCVD="" S IBQ=1 W !," >> RATE TYPE (399.3) '",IBRCVN,"' not found."
54 S IBACND=$G(^IBE(350.1,+IBACN,0)) I IBACND="" S IBQ=1 W !," >> ACTION TYPE (350.1) '",IBACNN,"' not found."
55 S IBACCD=$G(^IBE(350.1,+IBACC,0)) I IBACCD="" S IBQ=1 W !," >> ACTION TYPE (350.1) '",IBACCN,"' not found."
56 S IBACUD=$G(^IBE(350.1,+IBACU,0)) I IBACUD="" S IBQ=1 W !," >> ACTION TYPE (350.1) '",IBACUN,"' not found."
57 I IBQ D G CHKIBQ
58 .W !!,"Required file entries are missing. You should determine why you do not"
59 .W !,"have these entries before continuing. They should have been installed"
60 .W !,"with the installation of IB v2.0."
61 ;
62 ; check that Rate Types have not been modified since release of IB v2.0
63 I '$P(IBRTPD,U,3) S IBQ=1 W !!," >> RATE TYPE (399.3) '",IBRTPN,"' is not Inactive."
64 I +$P(IBRTPD,U,6) D
65 .W !!," >> RATE TYPE (399.3) '",IBRTPN,"' already has a pointer"
66 .W !," to an ACCOUNTS RECEIVABLE CATEGORY (430.2)."
67 .W !," This RATE TYPE will be re-pointed to a new CATEGORY in this installation."
68 ;
69 I '$P(IBRCVD,U,3) S IBQ=1 W !!," >> RATE TYPE (399.3) '",IBRCVN,"' is not Inactive."
70 I +$P(IBRCVD,U,6) D
71 .W !!," >> RATE TYPE (399.3) '",IBRCVN,"' already has a pointer"
72 .W !," to an ACCOUNTS RECEIVABLE CATEGORY (430.2)."
73 .W !," This RATE TYPE will be re-pointed to a new CATEGORY in this installation."
74 ;
75 I IBQ D
76 .W !!,"RATE TYPE entries have changed since the release of IB 2.0. You should"
77 .W !,"determine why these entries may have changed, and then inactivate"
78 .W !,"the Rate Types again, before re-running the initialization."
79 ;
80CHKIBQ K IBRTPN,IBRTPD,IBRCVN,IBRCVD,IBACNN,IBACND,IBACCN,IBACCD,IBACUN,IBACUD
81 Q
82 ;
83 ;
84RERUN() ; Has the installation already been run?
85 N X,Y,Z S (X,Y,Z)=0
86 F S X=$O(^IBE(350.2,"B","CHAMPVA PER DIEM",X)) Q:'X S Y=X
87 I Y S Y=$G(^IBE(350.2,Y,0)) I $P(Y,"^",2)=2941001,+$P(Y,"^",4)=9.5 S Z=1
88 Q Z
Note: See TracBrowser for help on using the repository browser.