| [613] | 1 | RTSM61 ;PKE/ISC-ALBANY more clinic requests sh. admis. ;9/1/90
|
|---|
| 2 | ;;v 2.0;Record Tracking;;10/22/91
|
|---|
| 3 | EN 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
|
|---|
| 8 | ST 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 | ;
|
|---|
| 11 | START 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
|
|---|
| 13 | APL ;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
|
|---|
| 29 | CREATE ;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)_"]"
|
|---|
| 38 | PUL ;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
|
|---|
| 46 | Q 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
|
|---|
| 48 | RTSD ;
|
|---|
| 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
|
|---|
| 51 | CHK S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y S RTB=Y Q
|
|---|
| 52 | ;
|
|---|
| 53 | CHK1 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
|
|---|
