Changeset 623 for WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTQ2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTQ2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTQ2.m
r613 r623 1 RTQ2 2 ;;2.0;Record Tracking;**13,15,21,45**;10/22/91;Build 7 3 BLD I $D(SDPL)S RTINP=+$P(^RTV(195.9,RTB,0),"^",3)4 5 6 7 8 9 10 11 BLD1 12 13 BLD2 14 15 16 17 18 CREATE 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 Q 43 44 45 PULL 46 47 48 LOCK 49 50 51 52 CANCEL 53 54 55 56 RTSD 57 58 59 CHK 60 61 QUE 62 63 64 65 66 67 68 69 DQ 70 71 72 73 74 DOC 75 76 77 78 79 1 RTQ2 ;MJK,JSM/TROY ISC;Scheduling Link; ; 5/21/87 3:09 PM ; 2 ;;v 2.0;Record Tracking;**13,15,21**;10/22/91 3 BLD I 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 ; 11 BLD1 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) 13 BLD2 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 18 CREATE 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 42 Q 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 ; 45 PULL 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) 48 LOCK 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 ; 52 CANCEL 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 ; 56 RTSD 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 ; 59 CHK S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y S RTB=Y Q 60 ; 61 QUE 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 ; 69 DQ 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 ; 74 DOC ; 75 ; 76 ; 77 ; 78 ; in: SDSC=clinic#, SDTTM=appt d/t, DFN=patient# 79 ; out: RTPAR=parent request#, RTSD(n)=volumes selected
Note:
See TracChangeset
for help on using the changeset viewer.
