RTQ2 ;MJK,JSM/TROY ISC;Scheduling Link; ; 5/21/87 3:09 PM ;
;;2.0;Record Tracking;**13,15,21,45**;10/22/91;Build 7
BLD I $D(SDPL) S RTINP=+$P(^RTV(195.9,RTB,0),"^",3)
E S RTINP=0
F RTBLD=0:0 S RTBLD=$O(^RTV(195.9,RTB,"RECS",RTBLD)) Q:'RTBLD S X=$G(^(RTBLD,0)) I X]"" D
. I $D(RTINP(RTINP)) Q ; don't create for inpts
. I $P($G(^DIC(195.1,+RTINP,4)),"^",3)="n",'$D(^RT("AT",+X,DFN_";DPT(")) Q ; don't create record, no record exists
. D BLD1 S RTSD=""
Q
;
BLD1 Q:$S('$D(^DIC(195.2,+X,0)):1,$P(X,"^",2)']"":1,$P(X,"^",2)="n":1,1:0)
S RTTY=+X,RTTYR(+X)="",RTAPL=+$P(X,"^",3),RTSEL=$C($A($P(X,"^",2))-32)
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
I 'L1 K RTSHOW D TYPE1^RTDPA1 S RTTY=+RTTY G BLD2
S:RTSEL["L" RTSD(L1)=+RTAPL
Q
;ent from SD
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)
S RTAPPIEN("MAS")=+^DIC(195.4,1,"MAS"),RTAPP("MAS")=$G(^DIC(195.1,RTAPPIEN("MAS"),4))
S RTAPPIEN("RAD")=+^DIC(195.4,1,"RAD"),RTAPP("RAD")=$G(^DIC(195.1,RTAPPIEN("RAD"),4))
;exclude inpatients by app
K RTINP I SDPL,$D(^DPT(DFN,.1)),^(.1)]"" DO
.I +RTAPP("MAS") S RTINP(RTAPPIEN("MAS"))=""
.I +RTAPP("RAD") S RTINP(RTAPPIEN("RAD"))=""
I $D(RTINP(RTAPPIEN("MAS"))),$D(RTINP(RTAPPIEN("RAD"))) K RTINP Q
;
I '$D(RTCLEX),$D(RTEXCLUD)>9,$D(^DPT(DFN,"S",SDTTM,0)),RTEXCLUD(RTA)[(U_$P(^(0),"^",16)_U) Q
I $D(^RTV(195.9,Y,0)),$P(^(0),"^")[";SC(",$D(^SC(+^(0),0)) S SDSC=+^RTV(195.9,Y,0),RTB=Y
I '$D(^SC("ARAD",SDSC,SDTTM,DFN)),$P(^RTV(195.9,RTB,0),"^",14)="n" Q
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)_"]"
S X=RTB,A=+RTA K RTA,RTSD,RTDIV D INST1^RTUTL G Q:'$D(RTINST) S RTDIV=RTINST
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
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
. I $D(RTINP(RTAPPIEN("MAS"))) Q ; don't create for inpatients
. I $P(RTAPP("MAS"),"^",3)="n",'$D(^RT("AT",+X,DFN_";DPT(")) Q ; don't create record, no record exists
. D BLD1
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
. I $D(RTINP(RTAPPIEN("RAD"))) Q ; don't create for inpatients
. I $P(RTAPP("RAD"),"^",3)="n",'$D(^RT("AT",+X,DFN_";DPT(")) Q ; don't create record, no record exists
. D BLD1:'$D(RTTYR(+X))
D RTSD I $D(RTPAR),SDPL D RTSET^SDUTL
Q K RTINP,RTAPP,RTAPPIEN,RTBLD,RTTYR,RTBKGRD,RTPAR,RTSD,RT,RTSEL
K A,Z,L,L1,I,RTINST,RTDIV,RTPULL,RTPN,RTTY,RTTYP,RTAPL,RTQ,RTY,RTS,RTQDT,RTB,RTPLTY,RTE D CLOSE^RTUTL Q
;
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
I I S RTPULL=I Q
S I=$P(^RTV(194.2,0),"^",3)
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
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)
S (DA,RTPULL)=I,DR="[RT PULL LIST]",DIE="^RTV(194.2," D ^DIE K DQ,DE Q
;
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
F RTQ=0:0 S RTQ=$O(^RTV(190.1,"APAR",RTPAR,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)) X RTCAN
K RTCAN,RTQ,RTSTAT Q
;
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
Q
;
CHK S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y S RTB=Y Q
;
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
;
I $P(SDTTM,".")'=DT,SDPL,SDRT="A",$P(^DIC(195.4,1,0),"^",5) Q
;S SAVX=X
X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="DQ^RTQ2",ZTDTH=$H
F V="DUZ(0)","SDSC","SDTTM","SDPL","DFN","RTCOM","RTCLEX" I $D(@V) S ZTSAVE(V)=""
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
;
DQ S RTBKGRD="",U="^" K V S X="T",%DT="" D ^%DT S DT=Y
;I $P(^DIC(195.4,1,0),"^",5) S SDPL=0
G CREATE
;
;
DOC ;
;
;
;
; in: SDSC=clinic#, SDTTM=appt d/t, DFN=patient#
; out: RTPAR=parent request#, RTSD(n)=volumes selected
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTQ2 4789 printed Dec 13, 2024@02:34:28 Page 2
RTQ2 ;MJK,JSM/TROY ISC;Scheduling Link; ; 5/21/87 3:09 PM ;
+1 ;;2.0;Record Tracking;**13,15,21,45**;10/22/91;Build 7
BLD IF $DATA(SDPL)
SET RTINP=+$PIECE(^RTV(195.9,RTB,0),"^",3)
+1 IF '$TEST
SET RTINP=0
+2 FOR RTBLD=0:0
SET RTBLD=$ORDER(^RTV(195.9,RTB,"RECS",RTBLD))
if 'RTBLD
QUIT
SET X=$GET(^(RTBLD,0))
IF X]""
Begin DoDot:1
+3 ; don't create for inpts
IF $DATA(RTINP(RTINP))
QUIT
+4 ; don't create record, no record exists
IF $PIECE($GET(^DIC(195.1,+RTINP,4)),"^",3)="n"
IF '$DATA(^RT("AT",+X,DFN_";DPT("))
QUIT
+5 DO BLD1
SET RTSD=""
End DoDot:1
+6 QUIT
+7 ;
BLD1 if $SELECT('$DATA(^DIC(195.2,+X,0))
QUIT
+1 SET RTTY=+X
SET RTTYR(+X)=""
SET RTAPL=+$PIECE(X,"^",3)
SET RTSEL=$CHAR($ASCII($PIECE(X,"^",2))-32)
BLD2 SET (L,L1)=0
FOR I=0:0
SET I=$ORDER(^RT("AT",RTTY,RTE,I))
if 'I
QUIT
IF $DATA(^RT(I,0))
if RTSEL["A"
SET RTSD(I)=+RTAPL
if $PIECE(^(0),"^",7)>L
SET L=$PIECE(^(0),"^",7)
SET L1=I
+1 IF 'L1
KILL RTSHOW
DO TYPE1^RTDPA1
SET RTTY=+RTTY
GOTO BLD2
+2 if RTSEL["L"
SET RTSD(L1)=+RTAPL
+3 QUIT
+4 ;ent from SD
CREATE if '$DATA(^SC(SDSC,0))
QUIT
SET Y=^(0)
SET RTB=SDSC_";SC("
SET RTA=+^DIC(195.4,1,$SELECT(SDPL:"MAS",$PIECE(Y,"^",3)="I":"RAD",1:"MAS"))
DO CHK
SET Y=+$PIECE(^RTV(195.9,Y,0),"^",12)
+1 SET RTAPPIEN("MAS")=+^DIC(195.4,1,"MAS")
SET RTAPP("MAS")=$GET(^DIC(195.1,RTAPPIEN("MAS"),4))
+2 SET RTAPPIEN("RAD")=+^DIC(195.4,1,"RAD")
SET RTAPP("RAD")=$GET(^DIC(195.1,RTAPPIEN("RAD"),4))
+3 ;exclude inpatients by app
+4 KILL RTINP
IF SDPL
IF $DATA(^DPT(DFN,.1))
IF ^(.1)]""
Begin DoDot:1
+5 IF +RTAPP("MAS")
SET RTINP(RTAPPIEN("MAS"))=""
+6 IF +RTAPP("RAD")
SET RTINP(RTAPPIEN("RAD"))=""
End DoDot:1
+7 IF $DATA(RTINP(RTAPPIEN("MAS")))
IF $DATA(RTINP(RTAPPIEN("RAD")))
KILL RTINP
QUIT
+8 ;
+9 IF '$DATA(RTCLEX)
IF $DATA(RTEXCLUD)>9
IF $DATA(^DPT(DFN,"S",SDTTM,0))
IF RTEXCLUD(RTA)[(U_$PIECE(^(0),"^",16)_U)
QUIT
+10 IF $DATA(^RTV(195.9,Y,0))
IF $PIECE(^(0),"^")[";SC("
IF $DATA(^SC(+^(0),0))
SET SDSC=+^RTV(195.9,Y,0)
SET RTB=Y
+11 IF '$DATA(^SC("ARAD",SDSC,SDTTM,DFN))
IF $PIECE(^RTV(195.9,RTB,0),"^",14)="n"
QUIT
+12 SET Y=^SC(SDSC,0)
SET RTE=DFN_";DPT("
SET RTPLTY=1
SET (RTQDT,X)=SDTTM
SET RTPN=$PIECE(Y,"^")_" ["_$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_"]"
+13 SET X=RTB
SET A=+RTA
KILL RTA,RTSD,RTDIV
DO INST1^RTUTL
if '$DATA(RTINST)
GOTO Q
SET RTDIV=RTINST
+14 if $SELECT('SDPL:0,'$DATA(^SC(SDSC,"S",SDTTM,1,SDPL,0)):1,DFN'=+^(0):1,$PIECE(^(0),"^",9)["C":1,$DATA(^("RTR")):1,1:0)
GOTO Q
DO BLD
+15 IF SDPL
IF '$DATA(RTSD)
FOR RTBLD=0:0
SET RTBLD=$ORDER(^DIC(195.1,RTAPPIEN("MAS"),"MAS",RTBLD))
if 'RTBLD
QUIT
IF $DATA(^(RTBLD,0))
SET X=^(0)
Begin DoDot:1
+16 ; don't create for inpatients
IF $DATA(RTINP(RTAPPIEN("MAS")))
QUIT
+17 ; don't create record, no record exists
IF $PIECE(RTAPP("MAS"),"^",3)="n"
IF '$DATA(^RT("AT",+X,DFN_";DPT("))
QUIT
+18 DO BLD1
End DoDot:1
+19 ; only stored under MAS application
IF SDPL
IF $DATA(^SC("ARAD",SDSC,SDTTM,DFN))
IF $PIECE(^(DFN),"^")'["N"
FOR RTBLD=0:0
SET RTBLD=$ORDER(^DIC(195.1,RTAPPIEN("MAS"),"RAD",RTBLD))
if 'RTBLD
QUIT
IF $DATA(^(RTBLD,0))
SET X=^(0)
Begin DoDot:1
+20 ; don't create for inpatients
IF $DATA(RTINP(RTAPPIEN("RAD")))
QUIT
+21 ; don't create record, no record exists
IF $PIECE(RTAPP("RAD"),"^",3)="n"
IF '$DATA(^RT("AT",+X,DFN_";DPT("))
QUIT
+22 if '$DATA(RTTYR(+X))
DO BLD1
End DoDot:1
+23 DO RTSD
IF $DATA(RTPAR)
IF SDPL
DO RTSET^SDUTL
Q KILL RTINP,RTAPP,RTAPPIEN,RTBLD,RTTYR,RTBKGRD,RTPAR,RTSD,RT,RTSEL
+1 KILL A,Z,L,L1,I,RTINST,RTDIV,RTPULL,RTPN,RTTY,RTTYP,RTAPL,RTQ,RTY,RTS,RTQDT,RTB,RTPLTY,RTE
DO CLOSE^RTUTL
QUIT
+2 ;
PULL FOR I=0:0
SET I=$ORDER(^RTV(194.2,"B",RTPN,I))
if 'I
QUIT
IF $DATA(^RTV(194.2,I,0))
IF $PIECE(^(0),"^",15)=+RTAPL
IF $PIECE(^(0),"^",2)=$PIECE(RTQDT,".")
QUIT
+1 IF I
SET RTPULL=I
QUIT
+2 SET I=$PIECE(^RTV(194.2,0),"^",3)
LOCK SET I=I+1
LOCK +^RTV(194.2,I):1
IF '$TEST!$DATA(^RTV(194.2,I))
LOCK -^RTV(194.2,I)
GOTO LOCK
+1 SET ^RTV(194.2,I,0)=RTPN_"^^^^^^^^^^^^^^"_+RTAPL
SET ^RTV(194.2,"B",RTPN,I)=""
SET ^RTV(194.2,"AC",+RTAPL,I)=""
SET ^(0)=$PIECE(^RTV(194.2,0),"^",1,2)_"^"_I_"^"_($PIECE(^(0),"^",4)+1)
SET ^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RTV(194.2,")=I
LOCK -^RTV(194.2,I)
+2 SET (DA,RTPULL)=I
SET DR="[RT PULL LIST]"
SET DIE="^RTV(194.2,"
DO ^DIE
KILL DQ,DE
QUIT
+3 ;
CANCEL if '$DATA(^RTV(190.1,+RTPAR,0))
QUIT
SET (RTQ,RTPAR)=+RTPAR
SET 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"
XECUTE RTCAN
+1 FOR RTQ=0:0
SET RTQ=$ORDER(^RTV(190.1,"APAR",RTPAR,RTQ))
if 'RTQ
QUIT
IF $DATA(^RTV(190.1,RTQ,0))
XECUTE RTCAN
+2 KILL RTCAN,RTQ,RTSTAT
QUIT
+3 ;
RTSD KILL RTPAR
FOR RT=0:0
SET RT=$ORDER(RTSD(RT))
if 'RT
QUIT
SET RTB=SDSC_";SC("
SET (RTA,RTAPL)=+RTSD(RT)
DO CHK
KILL RTA,RTQ
if SDPL
DO PULL
DO SET^RTQ
if '$DATA(RTQ)
KILL RTSD(RT)
IF '$DATA(RTPAR)
IF $DATA(RTQ)
SET RTPAR=RTQ
+1 QUIT
+2 ;
CHK SET Y=+$ORDER(^RTV(195.9,"ABOR",RTB,RTA,0))
if 'Y
DO SET^RTDPA3
SET RTB=Y
QUIT
+1 ;
QUE IF SDPL
IF $PIECE(SDTTM,".")=DT
SET X="I"
SET RTCLEX=""
DO SAVE^RTQ3
DO ASK^RTQ3
KILL RTESC
if $EXTRACT(X)'="Y"
SET RTESC=""
SET X="I"
DO RESTORE^RTQ3
SET X=SDTTM
IF $DATA(RTESC)
KILL RTESC,RTCLEX
QUIT
+1 ;
+2 IF $PIECE(SDTTM,".")'=DT
IF SDPL
IF SDRT="A"
IF $PIECE(^DIC(195.4,1,0),"^",5)
QUIT
+3 ;S SAVX=X
+4 XECUTE ^%ZOSF("UCI")
SET ZTUCI=Y
SET ZTRTN="DQ^RTQ2"
SET ZTDTH=$HOROLOG
+5 FOR V="DUZ(0)","SDSC","SDTTM","SDPL","DFN","RTCOM","RTCLEX"
IF $DATA(@V)
SET ZTSAVE(V)=""
+6 SET ZTDESC="MAS/X-RAY Record Request Link"
SET ZTIO=$PIECE(^DIC(195.4,1,0),"^",3)
KILL H,V,ZTSK
NEW X
DO ^%ZTLOAD
QUIT
+7 ;
DQ SET RTBKGRD=""
SET U="^"
KILL V
SET X="T"
SET %DT=""
DO ^%DT
SET DT=Y
+1 ;I $P(^DIC(195.4,1,0),"^",5) S SDPL=0
+2 GOTO CREATE
+3 ;
+4 ;
DOC ;
+1 ;
+2 ;
+3 ;
+4 ; in: SDSC=clinic#, SDTTM=appt d/t, DFN=patient#
+5 ; out: RTPAR=parent request#, RTSD(n)=volumes selected
