source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTSM6.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1RTSM6 ;PKE/TROY,RAY/BED-Record Requestor; ; 5/15/87 9:01 AM ;
2 ;;v 2.0;Record Tracking;**8,13,18**;10/22/91
3 ;schedule in taskman at night, initializes clinics from T to param
419 ;Dailey Clinic Request init
5 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"
6 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
7 Q
8START ;
9 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
10 ;
11UP S RTMASS=+^DIC(195.4,1,"MAS"),RTRAD=+^("RAD") D GET K ^TMP($J)
12 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
13 D:$D(XRTL) T0^%ZOSV ; monitor pull list create et
14 S RTMAS=RTMASS,RTBKGRD=""
15 F RTSC=0:0 S RTSC=$O(^SC(RTSC)) Q:'RTSC I $D(^SC(RTSC,0)),$P(^(0),"^",3)="C" D APP
16 S RTMAS=RTMASS,RTBKGRD=""
17 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; end pull list et
18 D EN^RTSM61
19 D NOW^%DTC S Y=$E(%,1,12) D D^DIQ K X S X(2)=" STOP DATE/TIME: "_Y,X(3)=" " D UTL
20 S RTLN=4,RTHD=" # Requests for "
21 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:"")
22 ;
23 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"
24 S RTLN=RTLN+4
25 F RTLN=RTLN:1:RTLN+3 S X(RTLN)=" "
26 D UTL
27 D EN^RTSM7
28 D MAIL
29Q16 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
30 ;
31APP 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
32 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
33 Q
34RTQ 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 "."
35 S RTMAS=RTMASS
36 Q
37CNT I RTMAS=RTRAD,'$D(^SC("ARAD",RTSC,RTTM,DFN))!('$P(^DIC(195.4,1,"UP"),"^",2)) Q
38 S D=$P(SDTTM,".") I $D(RTSCOUNT(RTMAS,D)) S RTSCOUNT(RTMAS,D)=RTSCOUNT(RTMAS,D)+1
39 E S RTSCOUNT(RTMAS,D)=1
40 K D
41 Q
42MAIL S XMSUB="Record Tracking Clinic Request Initializer",XMTEXT="^TMP($J,""TX""," K XMY
43 S RTMAS=+^DIC(195.4,1,"MAS"),RTRAD=+^("RAD")
44 S X=$P(^DIC(195.1,RTMAS,0),"^",14) D MGRP
45 S X=$P(^DIC(195.1,RTRAD,0),"^",14) D MGRP
46 I '$D(XMY) S X=$O(^XMB(3.8,"B","RT CLINIC REQUESTS",0)) D MGRP
47 I $D(DUZ)#2,DUZ S XMY(DUZ)=""
48 E S XMY(.5)=""
49 S XMDUZ=.5 D ^XMD K XMDUZ,XMY,XMSUB,XMTEXT,XMZ K ^TMP($J,"TX") Q
50 ;
51MGRP I X S XMY("G."_$P($G(^XMB(3.8,X,0)),"^",1))=""
52 Q
53UTL F Z=0:0 S Z=$O(X(Z)) Q:'Z S ^TMP($J,"TX",Z,0)=X(Z)
54 K X Q
55 ;
56GET 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
Note: See TracBrowser for help on using the repository browser.