source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTSM61.m@ 1521

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1RTSM61 ;PKE/ISC-ALBANY more clinic requests sh. admis. ;9/1/90
2 ;;v 2.0;Record Tracking;;10/22/91
3EN F A=0:0 S A=$O(^RTV(195.9,"AD","y",A)) Q:'A I $D(^RTV(195.9,A,"ADM")),$D(^(0)) S RTSA(A)=$P(^(0),"^",1,3)_"^"_$P(^("ADM"),"^",2)
4 ;
5 I $D(^DIC(195.1,+^DIC(195.4,1,"MAS"),4)) S RTSA("MAS")=$P(^(4),"^",2)_"^^"_+^DIC(195.4,1,"MAS")
6 I $D(^DIC(195.1,+^DIC(195.4,1,"RAD"),4)) S RTSA("RAD")=$P(^(4),"^",2)_"^^"_+^DIC(195.4,1,"RAD")
7 K A,B
8ST S X="T",%DT="" D ^%DT S RTBEG=Y S X="T+"_(0+$S($D(^DIC(195.4,1,0)):$S($P(^(0),"^",6):$P(^(0),"^",6),1:7),1:7)) D ^%DT S RTEND=Y_".2359" K %DT
9 ;S RTBEG=2880101
10 ;
11START F RTTM=(RTBEG-.0001):0 S RTTM=$O(^DGS(41.1,"C",RTTM)) Q:'RTTM!(RTEND<RTTM) F RTSAA=0:0 S RTSAA=$O(^DGS(41.1,"C",RTTM,RTSAA)) Q:'RTSAA I $D(^DGS(41.1,RTSAA,0)) S A0=^(0) D APL
12 K R,RTTM,RTSA,RTSAA,Q0,RTBOR,RTAA,RTBKGRD Q
13APL ;A T/W,Ward,Treatsp get RTBOR pointer to Borrower
14 I $P(A0,"^",13) Q ;canceled
15 K RTBOR
16 S A=$P(A0,"^",10),W=$P(A0,"^",8),T=$P(A0,"^",9),DFN=+A0
17 ;see if any sa borrowers have treat spec.
18 I A="T" F Z=0:0 S Z=$O(RTSA(Z)) Q:'Z I $P(RTSA(Z),"^",4)=T S RTBOR($P(RTSA(Z),"^",3))=Z
19 ;see if any sa borrowers are ward locations
20 I A="W" F Z=0:0 S Z=$O(RTSA(Z)) Q:'Z I (+$P(RTSA(Z),"^",1)=W) S RTBOR($P(RTSA(Z),"^",3))=Z
21 ;RTBOR(1),RTBOR(2) not defined, default, set default
22 ;do directly from global
23 F Z="MAS","RAD" I $D(RTSA(Z)) S A=$P(RTSA(Z),"^",3) I '$D(RTBOR(A)) S RTBOR(A)=RTSA(Z)
24 K A,W,T,Z
25 I '$D(RTBOR) Q
26 ;Now loop borrower and create request, pull list.
27 F RTAA=0:0 S RTAA=$O(RTBOR(RTAA)) Q:'RTAA D CREATE
28 Q
29CREATE ;Have RTB,DFN,RTTM
30 ;exclude inpatients
31 I $D(^DPT(DFN,.1)),$D(^DIC(195.1,RTAA,4)),$P(^(4),"^") Q
32 I $D(^DIC(195.1,RTAA,4)),$P(^(4),"^",3)="n",'$D(^RT("AA",RTAA,DFN_";DPT(")) Q
33 S (Y,RTB)=+RTBOR(RTAA) I 'Y Q
34 S Y=$P(^RTV(195.9,Y,0),"^",12) I 'Y S Y=RTB ;associated borrower
35 S Y=$P(^RTV(195.9,Y,0),"^") D NAME^RTB S Y="SA "_Y
36 ;
37 S RTE=DFN_";DPT(",RTPLTY=1,(RTQDT,X)=RTTM,RTPN=$P(Y,"^")_" ["_$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_"]"
38PUL ;entry with RTB,RTA,Y
39 S X=RTB,A=+RTAA K RTA,RTSD,RTDIV D INST1^RTUTL G Q:'$D(RTINST) S RTDIV=RTINST
40 D BLD^RTQ2
41 ;
42 I '$D(RTSD),RTAA=1 F RTBLD=0:0 S RTBLD=$O(^DIC(195.1,+^DIC(195.4,1,"MAS"),"MAS",RTBLD)) Q:'RTBLD I $D(^(RTBLD,0)) S X=^(0) D BLD1^RTQ2
43 ;
44 I '$D(RTSD),RTAA=2 F RTBLD=0:0 S RTBLD=$O(^DIC(195.1,+^DIC(195.4,1,"MAS"),"RAD",RTBLD)) Q:'RTBLD I $D(^(RTBLD,0)) S X=^(0) D BLD1^RTQ2:'$D(RTTYR(+X))
45 D RTSD
46Q K RTBLD,RTTYR,RTPAR,RTSD,RT,RTSEL,A,Z,L,L1,I,RTINST,RTDIV,RTPULL,RTPN,RTTY,RTTYP,RTAPL,RTQ,RTY,RTS,RTQDT,RTB,RTPLTY,RTE
47 Q
48RTSD ;
49 K RTPAR F RT=0:0 S RT=$O(RTSD(RT)) Q:'RT S RTB=$P(^RTV(195.9,RTB,0),"^"),(RTA,RTAPL)=+RTSD(RT) D CHK K RTA,RTQ D PULL^RTQ2,CHK1 K:'$D(RTQ) RTSD(RT) I '$D(RTPAR),$D(RTQ) S RTPAR=RTQ
50 Q
51CHK S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y S RTB=Y Q
52 ;
53CHK1 F R=0:0 S R=$O(^RTV(190.1,"C",RTTM,R)) Q:'R I $D(^RTV(190.1,"ABOR",RTB,R)),$D(^RTV(190.1,R,0)) S Q0=^(0) I $P(Q0,"^")=RT,$P(Q0,"^",4)=RTTM,$P(Q0,"^",5)=RTB,$P(Q0,"^",10)=RTPULL Q
54 I 'R D SET^RTQ
55 Q
Note: See TracBrowser for help on using the repository browser.