RTSM6 ;PKE/TROY,RAY/BED-Record Requestor; ; 5/15/87 9:01 AM ;
;;v 2.0;Record Tracking;**8,13,18**;10/22/91
;schedule in taskman at night, initializes clinics from T to param
19 ;Dailey Clinic Request init
S X="T",%DT="" D ^%DT K %DT S DT=Y,%DT(0)=Y D DATE^RTUTL G Q16:'$D(RTEND) S:RTEND'["." RTEND=RTEND_".9999"
S RTDESC="Clinic Record Request Initialization Routine",RTVAR="RTBEG^RTEND",RTPGM="UP^RTSM6",(IOM,ION,IOST)="" D Q^RTUTL S IOP="" D ^%ZIS K IOP G Q16
Q
START ;
D NOW^%DTC S RTBEG=%,%DT="" 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
;
UP S RTMASS=+^DIC(195.4,1,"MAS"),RTRAD=+^("RAD") D GET K ^TMP($J)
D NOW^%DTC S Y=$E(%,1,12) D D^DIQ K X S X(1)=" Clinic Record Request Initialization START DATE/TIME: "_Y D UTL
D:$D(XRTL) T0^%ZOSV ; monitor pull list create et
S RTMAS=RTMASS,RTBKGRD=""
F RTSC=0:0 S RTSC=$O(^SC(RTSC)) Q:'RTSC I $D(^SC(RTSC,0)),$P(^(0),"^",3)="C" D APP
S RTMAS=RTMASS,RTBKGRD=""
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; end pull list et
D EN^RTSM61
D NOW^%DTC S Y=$E(%,1,12) D D^DIQ K X S X(2)=" STOP DATE/TIME: "_Y,X(3)=" " D UTL
S RTLN=4,RTHD=" # Requests for "
F Z=0:0 S Z=$O(RTSCOUNT(RTMASS,Z)) D:'Z UTL Q:'Z S RTLN=RTLN+1 S Y=Z D D^DIQ S X(RTLN)=RTHD_Y_" = "_$E(RTSCOUNT(RTMASS,Z)_" ",1,6)_$S($D(RTSCOUNT(RTRAD,Z)):" X-ray Requests = "_RTSCOUNT(RTRAD,Z),1:"")
;
S RTLN=RTLN+1,X(RTLN)="",X(RTLN+2)=" Any day that you DON'T receive this message you should run",X(RTLN+3)=" the CLINIC INITIALIZATION option before you run the Pull Lists"
S RTLN=RTLN+4
F RTLN=RTLN:1:RTLN+3 S X(RTLN)=" "
D UTL
D EN^RTSM7
D MAIL
Q16 K RTINP,RTBKGRD,BORROW,PERSON,DIC,DIE,DR,L0,LO,L,RTA,RTB,RTQ,RTERM,RTDUZ,RTSA,RTEXCLUD,RTDTW,RTMASS,RTHD,RTLN,Z,X,Y,I,RTRAD,RTMAS,RTDESC,RTVAR,RTPGM,DFN,RTSC,RTTM,RTPL,SDSC,SDTTM,SDPL,RTSCOUNT,RTBEG,RTEND D CLOSE^RTUTL Q
;
APP I $D(^RTV(195.9,"ABOR",(RTSC_";SC("),RTMAS)) S X=+$O(^(RTMAS,0)) I '$O(^(X)),$D(^RTV(195.9,X,0)),$P(^(0),"^",14)'="y" Q
F RTTM=(RTBEG-.0001):0 S RTTM=$O(^SC(RTSC,"S",RTTM)) Q:'RTTM!(RTEND<RTTM) F RTPL=0:0 S RTPL=$O(^SC(RTSC,"S",RTTM,1,RTPL)) Q:'RTPL I $D(^(RTPL,0)),$P(^(0),"^",9)'="C" S DFN=+^(0) D RTQ
Q
RTQ S SDSC=RTSC,SDTTM=RTTM,SDPL=RTPL,RTBKGRD="" D CREATE^RTQ2 I $D(^SC(RTSC,"S",RTTM,1,RTPL,"RTR")) F RTMAS=RTMASS,RTRAD D CNT I '$D(ZTQUEUED) W "."
S RTMAS=RTMASS
Q
CNT I RTMAS=RTRAD,'$D(^SC("ARAD",RTSC,RTTM,DFN))!('$P(^DIC(195.4,1,"UP"),"^",2)) Q
S D=$P(SDTTM,".") I $D(RTSCOUNT(RTMAS,D)) S RTSCOUNT(RTMAS,D)=RTSCOUNT(RTMAS,D)+1
E S RTSCOUNT(RTMAS,D)=1
K D
Q
MAIL S XMSUB="Record Tracking Clinic Request Initializer",XMTEXT="^TMP($J,""TX""," K XMY
S RTMAS=+^DIC(195.4,1,"MAS"),RTRAD=+^("RAD")
S X=$P(^DIC(195.1,RTMAS,0),"^",14) D MGRP
S X=$P(^DIC(195.1,RTRAD,0),"^",14) D MGRP
I '$D(XMY) S X=$O(^XMB(3.8,"B","RT CLINIC REQUESTS",0)) D MGRP
I $D(DUZ)#2,DUZ S XMY(DUZ)=""
E S XMY(.5)=""
S XMDUZ=.5 D ^XMD K XMDUZ,XMY,XMSUB,XMTEXT,XMZ K ^TMP($J,"TX") Q
;
MGRP I X S XMY("G."_$P($G(^XMB(3.8,X,0)),"^",1))=""
Q
UTL F Z=0:0 S Z=$O(X(Z)) Q:'Z S ^TMP($J,"TX",Z,0)=X(Z)
K X Q
;
GET F RTMAS=RTMASS,RTRAD S RTEXCLUD(RTMAS)=U,Z=0 F N=1:1 S Z=$O(^DIC(195.1,RTMAS,"EXCLUDE","B",Z)) Q:'Z S $P(RTEXCLUD(RTMAS),"^",N+1)=Z_U
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTSM6 3327 printed Oct 16, 2024@18:35:32 Page 2
RTSM6 ;PKE/TROY,RAY/BED-Record Requestor; ; 5/15/87 9:01 AM ;
+1 ;;v 2.0;Record Tracking;**8,13,18**;10/22/91
+2 ;schedule in taskman at night, initializes clinics from T to param
19 ;Dailey Clinic Request init
+1 SET X="T"
SET %DT=""
DO ^%DT
KILL %DT
SET DT=Y
SET %DT(0)=Y
DO DATE^RTUTL
if '$DATA(RTEND)
GOTO Q16
if RTEND'["."
SET RTEND=RTEND_".9999"
+2 SET RTDESC="Clinic Record Request Initialization Routine"
SET RTVAR="RTBEG^RTEND"
SET RTPGM="UP^RTSM6"
SET (IOM,ION,IOST)=""
DO Q^RTUTL
SET IOP=""
DO ^%ZIS
KILL IOP
GOTO Q16
+3 QUIT
START ;
+1 DO NOW^%DTC
SET RTBEG=%
SET %DT=""
SET X="T+"_(0+$SELECT($DATA(^DIC(195.4,1,0)):$SELECT($PIECE(^(0),"^",6):$PIECE(^(0),"^",6),1:7),1:7))
DO ^%DT
SET RTEND=Y_".2359"
KILL %DT
+2 ;
UP SET RTMASS=+^DIC(195.4,1,"MAS")
SET RTRAD=+^("RAD")
DO GET
KILL ^TMP($JOB)
+1 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO D^DIQ
KILL X
SET X(1)=" Clinic Record Request Initialization START DATE/TIME: "_Y
DO UTL
+2 ; monitor pull list create et
if $DATA(XRTL)
DO T0^%ZOSV
+3 SET RTMAS=RTMASS
SET RTBKGRD=""
+4 FOR RTSC=0:0
SET RTSC=$ORDER(^SC(RTSC))
if 'RTSC
QUIT
IF $DATA(^SC(RTSC,0))
IF $PIECE(^(0),"^",3)="C"
DO APP
+5 SET RTMAS=RTMASS
SET RTBKGRD=""
+6 ; end pull list et
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+7 DO EN^RTSM61
+8 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO D^DIQ
KILL X
SET X(2)=" STOP DATE/TIME: "_Y
SET X(3)=" "
DO UTL
+9 SET RTLN=4
SET RTHD=" # Requests for "
+10 FOR Z=0:0
SET Z=$ORDER(RTSCOUNT(RTMASS,Z))
if 'Z
DO UTL
if 'Z
QUIT
SET RTLN=RTLN+1
SET Y=Z
DO D^DIQ
SET X(RTLN)=RTHD_Y_" = "_$EXTRACT(RTSCOUNT(RTMASS,Z)_" ",1,6)_$SELECT($DATA(RTSCOUNT(RTRAD,Z)):" X-ray Requests = "_RTSCOUNT(RTRAD,Z),1:"")
+11 ;
+12 SET RTLN=RTLN+1
SET X(RTLN)=""
SET X(RTLN+2)=" Any day that you DON'T receive this message you should run"
SET X(RTLN+3)=" the CLINIC INITIALIZATION option before you run the Pull Lists"
+13 SET RTLN=RTLN+4
+14 FOR RTLN=RTLN:1:RTLN+3
SET X(RTLN)=" "
+15 DO UTL
+16 DO EN^RTSM7
+17 DO MAIL
Q16 KILL RTINP,RTBKGRD,BORROW,PERSON,DIC,DIE,DR,L0,LO,L,RTA,RTB,RTQ,RTERM,RTDUZ,RTSA,RTEXCLUD,RTDTW,RTMASS,RTHD,RTLN,Z,X,Y,I,RTRAD,RTMAS,RTDESC,RTVAR,RTPGM,DFN,RTSC,RTTM,RTPL,SDSC,SDTTM,SDPL,RTSCOUNT,RTBEG,RTEND
DO CLOSE^RTUTL
QUIT
+1 ;
APP IF $DATA(^RTV(195.9,"ABOR",(RTSC_";SC("),RTMAS))
SET X=+$ORDER(^(RTMAS,0))
IF '$ORDER(^(X))
IF $DATA(^RTV(195.9,X,0))
IF $PIECE(^(0),"^",14)'="y"
QUIT
+1 FOR RTTM=(RTBEG-.0001):0
SET RTTM=$ORDER(^SC(RTSC,"S",RTTM))
if 'RTTM!(RTEND<RTTM)
QUIT
FOR RTPL=0:0
SET RTPL=$ORDER(^SC(RTSC,"S",RTTM,1,RTPL))
if 'RTPL
QUIT
IF $DATA(^(RTPL,0))
IF $PIECE(^(0),"^",9)'="C"
SET DFN=+^(0)
DO RTQ
+2 QUIT
RTQ SET SDSC=RTSC
SET SDTTM=RTTM
SET SDPL=RTPL
SET RTBKGRD=""
DO CREATE^RTQ2
IF $DATA(^SC(RTSC,"S",RTTM,1,RTPL,"RTR"))
FOR RTMAS=RTMASS,RTRAD
DO CNT
IF '$DATA(ZTQUEUED)
WRITE "."
+1 SET RTMAS=RTMASS
+2 QUIT
CNT IF RTMAS=RTRAD
IF '$DATA(^SC("ARAD",RTSC,RTTM,DFN))!('$PIECE(^DIC(195.4,1,"UP"),"^",2))
QUIT
+1 SET D=$PIECE(SDTTM,".")
IF $DATA(RTSCOUNT(RTMAS,D))
SET RTSCOUNT(RTMAS,D)=RTSCOUNT(RTMAS,D)+1
+2 IF '$TEST
SET RTSCOUNT(RTMAS,D)=1
+3 KILL D
+4 QUIT
MAIL SET XMSUB="Record Tracking Clinic Request Initializer"
SET XMTEXT="^TMP($J,""TX"","
KILL XMY
+1 SET RTMAS=+^DIC(195.4,1,"MAS")
SET RTRAD=+^("RAD")
+2 SET X=$PIECE(^DIC(195.1,RTMAS,0),"^",14)
DO MGRP
+3 SET X=$PIECE(^DIC(195.1,RTRAD,0),"^",14)
DO MGRP
+4 IF '$DATA(XMY)
SET X=$ORDER(^XMB(3.8,"B","RT CLINIC REQUESTS",0))
DO MGRP
+5 IF $DATA(DUZ)#2
IF DUZ
SET XMY(DUZ)=""
+6 IF '$TEST
SET XMY(.5)=""
+7 SET XMDUZ=.5
DO ^XMD
KILL XMDUZ,XMY,XMSUB,XMTEXT,XMZ
KILL ^TMP($JOB,"TX")
QUIT
+8 ;
MGRP IF X
SET XMY("G."_$PIECE($GET(^XMB(3.8,X,0)),"^",1))=""
+1 QUIT
UTL FOR Z=0:0
SET Z=$ORDER(X(Z))
if 'Z
QUIT
SET ^TMP($JOB,"TX",Z,0)=X(Z)
+1 KILL X
QUIT
+2 ;
GET FOR RTMAS=RTMASS,RTRAD
SET RTEXCLUD(RTMAS)=U
SET Z=0
FOR N=1:1
SET Z=$ORDER(^DIC(195.1,RTMAS,"EXCLUDE","B",Z))
if 'Z
QUIT
SET $PIECE(RTEXCLUD(RTMAS),"^",N+1)=Z_U
