source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTQ2.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1RTQ2 ;MJK,JSM/TROY ISC;Scheduling Link; ; 5/21/87 3:09 PM ;
2 ;;2.0;Record Tracking;**13,15,21,45**;10/22/91;Build 7
3BLD I $D(SDPL) S RTINP=+$P(^RTV(195.9,RTB,0),"^",3)
4 E S RTINP=0
5 F RTBLD=0:0 S RTBLD=$O(^RTV(195.9,RTB,"RECS",RTBLD)) Q:'RTBLD S X=$G(^(RTBLD,0)) I X]"" D
6 . I $D(RTINP(RTINP)) Q ; don't create for inpts
7 . I $P($G(^DIC(195.1,+RTINP,4)),"^",3)="n",'$D(^RT("AT",+X,DFN_";DPT(")) Q ; don't create record, no record exists
8 . D BLD1 S RTSD=""
9 Q
10 ;
11BLD1 Q:$S('$D(^DIC(195.2,+X,0)):1,$P(X,"^",2)']"":1,$P(X,"^",2)="n":1,1:0)
12 S RTTY=+X,RTTYR(+X)="",RTAPL=+$P(X,"^",3),RTSEL=$C($A($P(X,"^",2))-32)
13BLD2 S (L,L1)=0 F I=0:0 S I=$O(^RT("AT",RTTY,RTE,I)) Q:'I I $D(^RT(I,0)) S:RTSEL["A" RTSD(I)=+RTAPL S:$P(^(0),"^",7)>L L=$P(^(0),"^",7),L1=I
14 I 'L1 K RTSHOW D TYPE1^RTDPA1 S RTTY=+RTTY G BLD2
15 S:RTSEL["L" RTSD(L1)=+RTAPL
16 Q
17 ;ent from SD
18CREATE Q:'$D(^SC(SDSC,0)) S Y=^(0),RTB=SDSC_";SC(",RTA=+^DIC(195.4,1,$S(SDPL:"MAS",$P(Y,"^",3)="I":"RAD",1:"MAS")) D CHK S Y=+$P(^RTV(195.9,Y,0),"^",12)
19 S RTAPPIEN("MAS")=+^DIC(195.4,1,"MAS"),RTAPP("MAS")=$G(^DIC(195.1,RTAPPIEN("MAS"),4))
20 S RTAPPIEN("RAD")=+^DIC(195.4,1,"RAD"),RTAPP("RAD")=$G(^DIC(195.1,RTAPPIEN("RAD"),4))
21 ;exclude inpatients by app
22 K RTINP I SDPL,$D(^DPT(DFN,.1)),^(.1)]"" DO
23 .I +RTAPP("MAS") S RTINP(RTAPPIEN("MAS"))=""
24 .I +RTAPP("RAD") S RTINP(RTAPPIEN("RAD"))=""
25 I $D(RTINP(RTAPPIEN("MAS"))),$D(RTINP(RTAPPIEN("RAD"))) K RTINP Q
26 ;
27 I '$D(RTCLEX),$D(RTEXCLUD)>9,$D(^DPT(DFN,"S",SDTTM,0)),RTEXCLUD(RTA)[(U_$P(^(0),"^",16)_U) Q
28 I $D(^RTV(195.9,Y,0)),$P(^(0),"^")[";SC(",$D(^SC(+^(0),0)) S SDSC=+^RTV(195.9,Y,0),RTB=Y
29 I '$D(^SC("ARAD",SDSC,SDTTM,DFN)),$P(^RTV(195.9,RTB,0),"^",14)="n" Q
30 S Y=^SC(SDSC,0),RTE=DFN_";DPT(",RTPLTY=1,(RTQDT,X)=SDTTM,RTPN=$P(Y,"^")_" ["_$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_"]"
31 S X=RTB,A=+RTA K RTA,RTSD,RTDIV D INST1^RTUTL G Q:'$D(RTINST) S RTDIV=RTINST
32 G Q:$S('SDPL:0,'$D(^SC(SDSC,"S",SDTTM,1,SDPL,0)):1,DFN'=+^(0):1,$P(^(0),"^",9)["C":1,$D(^("RTR")):1,1:0) D BLD
33 I SDPL,'$D(RTSD) F RTBLD=0:0 S RTBLD=$O(^DIC(195.1,RTAPPIEN("MAS"),"MAS",RTBLD)) Q:'RTBLD I $D(^(RTBLD,0)) S X=^(0) D
34 . I $D(RTINP(RTAPPIEN("MAS"))) Q ; don't create for inpatients
35 . I $P(RTAPP("MAS"),"^",3)="n",'$D(^RT("AT",+X,DFN_";DPT(")) Q ; don't create record, no record exists
36 . D BLD1
37 I SDPL,$D(^SC("ARAD",SDSC,SDTTM,DFN)),$P(^(DFN),"^")'["N" F RTBLD=0:0 S RTBLD=$O(^DIC(195.1,RTAPPIEN("MAS"),"RAD",RTBLD)) Q:'RTBLD I $D(^(RTBLD,0)) S X=^(0) D ; only stored under MAS application
38 . I $D(RTINP(RTAPPIEN("RAD"))) Q ; don't create for inpatients
39 . I $P(RTAPP("RAD"),"^",3)="n",'$D(^RT("AT",+X,DFN_";DPT(")) Q ; don't create record, no record exists
40 . D BLD1:'$D(RTTYR(+X))
41 D RTSD I $D(RTPAR),SDPL D RTSET^SDUTL
42Q K RTINP,RTAPP,RTAPPIEN,RTBLD,RTTYR,RTBKGRD,RTPAR,RTSD,RT,RTSEL
43 K A,Z,L,L1,I,RTINST,RTDIV,RTPULL,RTPN,RTTY,RTTYP,RTAPL,RTQ,RTY,RTS,RTQDT,RTB,RTPLTY,RTE D CLOSE^RTUTL Q
44 ;
45PULL F I=0:0 S I=$O(^RTV(194.2,"B",RTPN,I)) Q:'I I $D(^RTV(194.2,I,0)),$P(^(0),"^",15)=+RTAPL,$P(^(0),"^",2)=$P(RTQDT,".") Q
46 I I S RTPULL=I Q
47 S I=$P(^RTV(194.2,0),"^",3)
48LOCK S I=I+1 L +^RTV(194.2,I):1 I '$T!$D(^RTV(194.2,I)) L -^RTV(194.2,I) G LOCK
49 S ^RTV(194.2,I,0)=RTPN_"^^^^^^^^^^^^^^"_+RTAPL,^RTV(194.2,"B",RTPN,I)="",^RTV(194.2,"AC",+RTAPL,I)="",^(0)=$P(^RTV(194.2,0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1),^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RTV(194.2,")=I L -^RTV(194.2,I)
50 S (DA,RTPULL)=I,DR="[RT PULL LIST]",DIE="^RTV(194.2," D ^DIE K DQ,DE Q
51 ;
52CANCEL Q:'$D(^RTV(190.1,+RTPAR,0)) S (RTQ,RTPAR)=+RTPAR,RTCAN="I $P(^(0),""^"",6)'=""x"" S DA=RTQ,DIE=""^RTV(190.1,"",DR=""[RT CHANGE REQUEST STATUS]"",RTSTAT=""x"" D ^DIE K DQ,DE" X RTCAN
53 F RTQ=0:0 S RTQ=$O(^RTV(190.1,"APAR",RTPAR,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)) X RTCAN
54 K RTCAN,RTQ,RTSTAT Q
55 ;
56RTSD K RTPAR F RT=0:0 S RT=$O(RTSD(RT)) Q:'RT S RTB=SDSC_";SC(",(RTA,RTAPL)=+RTSD(RT) D CHK K RTA,RTQ D PULL:SDPL,SET^RTQ K:'$D(RTQ) RTSD(RT) I '$D(RTPAR),$D(RTQ) S RTPAR=RTQ
57 Q
58 ;
59CHK S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y S RTB=Y Q
60 ;
61QUE I SDPL,$P(SDTTM,".")=DT S X="I",RTCLEX="" D SAVE^RTQ3,ASK^RTQ3 K RTESC S:$E(X)'="Y" RTESC="" S X="I" D RESTORE^RTQ3 S X=SDTTM I $D(RTESC) K RTESC,RTCLEX Q
62 ;
63 I $P(SDTTM,".")'=DT,SDPL,SDRT="A",$P(^DIC(195.4,1,0),"^",5) Q
64 ;S SAVX=X
65 X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="DQ^RTQ2",ZTDTH=$H
66 F V="DUZ(0)","SDSC","SDTTM","SDPL","DFN","RTCOM","RTCLEX" I $D(@V) S ZTSAVE(V)=""
67 S ZTDESC="MAS/X-RAY Record Request Link",ZTIO=$P(^DIC(195.4,1,0),"^",3) K H,V,ZTSK N X D ^%ZTLOAD Q
68 ;
69DQ S RTBKGRD="",U="^" K V S X="T",%DT="" D ^%DT S DT=Y
70 ;I $P(^DIC(195.4,1,0),"^",5) S SDPL=0
71 G CREATE
72 ;
73 ;
74DOC ;
75 ;
76 ;
77 ;
78 ; in: SDSC=clinic#, SDTTM=appt d/t, DFN=patient#
79 ; out: RTPAR=parent request#, RTSD(n)=volumes selected
Note: See TracBrowser for help on using the repository browser.