source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTDPA31.m@ 1078

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1RTDPA31 ;MJK/TROY ISC;Borrower File Screen Logic; ; 5/19/87 11:29 AM ;
2 ;;2.0;Record Tracking;**7,10,11,21,29**;10/22/91
3DICS ;
4 S Z0=^RTV(195.9,Y,0),Z=$P($P(Z0,U),";",2),Z1=$P(Z0,"^",10)
5 I Z1="r"!(Z1="i") X "I 0" G DICSQ
6 I $D(^RTV(195.9,Y,"KEY")),$P(^("KEY"),U)]"",'$D(^XUSEC($P(^("KEY"),U),DUZ)) X "I 0" G DICSQ
7DICS1 I '$D(^DIC(195.1,+$P(Z0,"^",3),"BOR","AC",Z)) X "I 0" G DICSQ
8 I Z="DIC(4,",$S('$D(^DIC(195.1,+$P(Z0,U,3),0)):1,$P(^(0),U,8)']"":1,1:'$D(^XUSEC($P(^(0),U,8),DUZ))) X "I 0" G DICSQ
9 I "SC(;DIC(42,"'[Z G DICSQ
10 ;inactive flags check
11 ;
12 ;I Z="VA(200," S Z1=$S('$P(^VA(200,+Z0,0),"^",11):1,1:DT'>$P(^(0),"^",11)) X "I Z1" G DICSQ
13 I Z="SC(" S Z1=$S('$D(^SC(+Z0,"I")):1,'^("I"):1,DT<+^("I"):1,'$P(^("I"),"^",2):0,DT>+$P(^("I"),"^",2):1,1:0) X "I Z1" G DICSQ
14 I Z="DIC(42," N D0,X S D0=+Z0 D WIN^DGPMDDCF X "I 'X"
15 ;
16DICSQ K Z,Z0,Z1 Q
17 ;
18RTQ S A=$S('$D(D0):0,'$D(^RTV(190.1,D0,0)):0,'$D(^RT(+^(0),0)):0,1:+$P(^(0),"^",4)) S A("RTQ")=""
19REC I '$D(A("RTQ")) S A=$S('$D(D0):0,'$D(^RT(D0,0)):0,1:+$P(^(0),"^",4))
20DIC S:A DIC("V")="S RTA="_A_" D DICV^RTDPA31 K RTA",DIC("DR")="3////"_A S:'A DIC("V")="I 0" K A Q
21MISS S A=$S('$D(D0):0,'$D(^RTV(190.2,D0,0)):0,'$D(^RT(+^(0),0)):0,1:+$P(^(0),"^",4)) G DIC
22HIS S A=$S('$D(D0):0,'$D(^RTV(190.3,D0,0)):0,'$D(^RT(+^(0),0)):0,1:+$P(^(0),"^",4)) G DIC
23PULL S A=$S('$D(D0):0,'$D(^RTV(194.2,D0,0)):0,1:$P(^(0),"^",15)) G DIC
24APL S A=$S('$D(D0):0,'$D(^DIC(195.1,D0,0)):0,1:D0) G DIC
25BOR S A=$S('$D(D0):0,'$D(^RTV(195.9,D0,0)):0,1:+$P(^(0),"^",3)) G DIC
26 ;
27DICV ;entry point to set DIC("V") for dd's; RTA defined as internal number of file 195.1
28 I '$D(^DIC(195.1,RTA,"BOR","B",+Y(0)))!('$D(^DIC(195.1,RTA,0))) X "I 0" Q
29 ;naked ref to current application in ^DIC(195.1,rta,0)
30 S P=$P(^(0),"^",8) I $S($P(Y(0),"^",4)'="I":1,P']"":0,1:$D(^XUSEC(P,DUZ)))
31 Q
32 ;
33HOMESCR ;DIC("S") for DEFAULT HOME LOCATION field
34 I $D(D0),$D(D1),$D(D2),$D(^DIC(195.2,"AF",Y,+^DIC(195.1,D0,"INST",D1,"TYPE",D2,0))),$D(^SC(+$P(^RTV(195.9,Y,0),U,2),0)),$P(^(0),U,4)=D1 D DICS
35 Q
Note: See TracBrowser for help on using the repository browser.