close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFQB.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFQB.m@ 1769

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
1IBDFQB ;ALB/MAF - MAIN QUEUE JOB FOR ENCOUNTER FORM PRINTING - FEB 2 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**15**;APR 24, 1997
3 ;
4EN ;
5 ; -- Goes through the "SEQ" cross reference to print the
6 ; highest priority jobs first (lowest sequence number).
7 N IBDFQUE,IBDFQDT,IBDFQD,IBDFQT,IBDFTSTP
8 S IBDFQUE=1,IBDFTSTP=1
9 S (IBDFNUM,IBDFNAME,IBDFIFN,IBDFSEQ,QUIT)=0
10 D NOW^%DTC S IBDFQDT=%,IBDFQD=$P(%,"."),IBDFQT=$E($P(%,".",2),1,4)
11 ;
12 F S IBDFSEQ=$O(^IBD(357.09,"SEQ",IBDFSEQ)) Q:IBDFSEQ']"" F S IBDFNUM=$O(^IBD(357.09,"SEQ",IBDFSEQ,IBDFNUM)) Q:IBDFNUM']"" F S IBDFIFN=$O(^IBD(357.09,"SEQ",IBDFSEQ,IBDFNUM,IBDFIFN)) Q:IBDFIFN']"" N IBDFARY D UP($$QUEUE(IBDFIFN))
13 ;
14 ; -- send forms pending pages to PCE automatically
15 D BCKGRND^IBDFFRFT
16 ;
17 G EXIT
18 ;
19 ;
20UP(IBTASK) ; -- store results of tasking
21 Q:'$G(IBTASK)
22 D TASK
23 Q
24 ;
25 ;
26QUEUE(IBDFIFN) ; -- Set up Queue variables
27 N ZTSK,ZTDTH,ZTRTN,ZTDESC,ZTSAVE,ZTION,X,Y
28 K ^TMP("IBDF",$J,"C"),^TMP("IBDF",$J,"D")
29 D SET
30 G:('$D(^TMP("IBDF",$J)))!QUIT CLEAR
31 ;
32 ; -- check if already tasked and running?
33 ;I $P(IBDFNODE,"^",11)]"" S ZTSK=$P(IBDFNODE,"^",11) D STAT^%ZTLOAD I "^1^2^"[ZTSK(1) S QUIT=1 G CLEAR
34 ;I $P(IBDFNODE,"^",11)]"" S ZTSK=$P(IBDFNODE,"^",11) W !,ZTSK,! B
35 S $P(^IBD(357.09,IBDFNUM,"Q",IBDFIFN,0),"^",14)=$P(IBDFNODE,"^",11)
36 ;
37 F IBDT=0:0 S IBDT=$O(IBDFARY(IBDT)) Q:'IBDT D
38 .S ZTDTH=$S('$D(ZTDTH):$H,$D(ZTDTH)&(ZTDTH]""):ZTDTH,1:$H)
39 .S ZTRTN="DQ^IBDFQB",ZTDESC="IBD - Encounter Forms for"_IBDFNAME,ZTSAVE("^TMP(""IBDF"",$J,")="",ZTSAVE("IB*")="",ZTIO=$S($P(IBDFNODE,"^",9)]"":$P(IBDFNODE,"^",9),1:"") D ^%ZTLOAD D HOME^%ZIS
40 ;
41 ; -- after queing, delete start and stop times and add task
42 ; -- once started add start time
43 ; -- once finished add stop time, delete task no.
44 ;
45 S IBZTSK=ZTSK
46 I '$D(ZTQUEUED) D ^%ZISC S QUIT=1
47 ;
48 ;
49CLEAR ; -- Clean up variables if task is not queued
50 K ^TMP("IBDF",$J),^TMP("IB",$J)
51 ;
52 I QUIT D
53 .I $D(ZTSK),$D(ZTSK(1)) I "^1^2^"[ZTSK(1) K ZTSK
54 .S IBZTSK=$S($D(ZTSK):ZTSK,1:"")
55 ;
56 S QUIT=0
57 Q $G(IBZTSK)
58 ;
59DQ ; -- Generic entry points to edit
60 ; -- only called by jobs tasked by this routine
61 S IBDFFLD=".02" D UPDT
62 D ^IBDF1B1
63 S IBDFFLD=".03" D UPDT
64 S IBTASK="@" D TASK
65 Q
66 ;
67UPDT ; -- Update start and finish times
68 N DIE,DA,DR
69 D NOW^%DTC S IBDFX=$E(%,1,12),DA=IBDFIFN,DA(1)=IBDFNUM,DIE="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DR=IBDFFLD_"///"_"^S X=IBDFX" D ^DIE Q
70 ;
71 ;
72TASK ; -- Update Task number and last date printed
73 N DA,DR,DIE
74 S DA=IBDFIFN,DA(1)=IBDFNUM,DIE="^IBD(357.09,"_DA(1)_","_"""Q"""_",",DR=".11///"_IBTASK_";.12///"_IBDT D ^DIE
75 I $D(IB1FLAG) S IB1TASK=IBTASK
76 Q
77 ;
78 ;
79EXIT K IBADDONS,IBCLN,IBDFDAY,IBDFIFN,IBDFINST,IBDFNAME,IBDFNODE,IBDFNOW,IBDFNUM,IBDFSEQ,IBDIV,IBDT,IBREPRNT,IBSRT,IBSTRTDV,IBDFDAY1,IBDFLAST,IBDFONE,IBDFQ,IBDFXX,IBZTSK,QUIT
80 I $D(ZTQUEUED) S ZTREQ="@" Q
81 D ^%ZISC
82 Q
83 ;
84 ;
85SET ; -- Set up variables needed for priniting of forms
86 S IBDFNODE=$G(^IBD(357.09,IBDFNUM,"Q",IBDFIFN,0))
87 I $P(IBDFNODE,"^",4)=""!($P(IBDFNODE,"^",5)="")!($P(IBDFNODE,"^",6)="")!($P(IBDFNODE,"^",7)="")!($P(IBDFNODE,"^",8)="")!($P(IBDFNODE,"^",9)="")!($P(IBDFNODE,"^",10)="") D I QUIT Q
88 .I '$D(IBDFQUE) W !!,"PRINT QUEUE ABORTED.... missing required parameters!!!!" D PAUSE^VALM1
89 .S QUIT=1
90 .Q
91 I $P(IBDFNODE,"^",8)="N" D I QUIT Q
92 .I '$D(IBDFQUE) W !!,"PRINT QUEUE ABORTED.....not an active print job... check Special Instructions" D PAUSE^VALM1
93 .S QUIT=1
94 .Q
95 S IBSRT=$P(IBDFNODE,"^",4),SELECTBY="C",IBADDONS=$P(IBDFNODE,"^",5),IBREPRNT="",IBSTRTDV=""
96 D ENTRY Q:QUIT D
97 .N GROUPS,IEN
98 .; -- GET PRINT MANAGER GROUPS
99 .S GROUPS=""
100 .S GROUPS($P(IBDFNODE,"^",6))="" D
101 ..S GROUPS=0 F S GROUPS=$O(GROUPS(GROUPS)) Q:'GROUPS D
102 ...S IEN=0 F S IEN=$O(^IBD(357.99,GROUPS,10,IEN)) Q:'IEN S IBCLN=+$G(^IBD(357.99,GROUPS,10,IEN,0)) S:IBCLN ^TMP("IBDF",$J,"C",IBCLN)=""
103 ...S IEN=0 F S IEN=$O(^IBD(357.99,GROUPS,11,IEN)) Q:'IEN S IBDIV=+$G(^IBD(357.99,GROUPS,11,IEN,0)) S:IBDIV ^TMP("IBDF",$J,"D",IBDIV)=""
104 Q
105 ;
106 ;
107ENTRY ; -- Calc date and do checks on special instructions
108 K IBDFARY
109 N IBDFNOW,IBDFINST,IBDFDATE,IBDFDAYS,IBDFCTR,IBDFQTIM
110 ;S IBDFNOW=$P($$NOW^XLFDT(),"."),IBDFINST=$P(IBDFNODE,"^",8),IBDFQTIM=$S($P(IBDFNODE,"^",13)]"":$P(IBDFNODE,"^",13),1:$E($P($$NOW^XLFDT(),".",2),1,4))
111 S IBDFNOW=$P($$NOW^XLFDT(),"."),IBDFINST=$P(IBDFNODE,"^",8),IBDFQTIM=$S($P(IBDFNODE,"^",13)]"":$P(IBDFNODE,"^",13),1:IBDFQT)
112 D:'$D(IBDFSING) ZTDTH
113 ;
114 ; -- if ignoring weekends and/or holidays, check current date
115 I IBDFINST["W" I $$WEEKEND(IBDFNOW) S QUIT=1 Q
116 I IBDFINST["H" I $$HOLIDAY(IBDFNOW) S QUIT=1 Q
117 I IBDFINST["I" I $$WEEKEND(IBDFNOW)!($$HOLIDAY(IBDFNOW)) S QUIT=1 Q
118 ;
119 ; -- find date to return - returned in IBDFARY(date) array
120 ; -- loop adds 1 day and checks if day is restricted
121 ; -- if not, it adds it as a printable day and compares it
122 ; -- with the number of printable days ahead the user wants to prn
123 S IBDFDATE=IBDFNOW,IBDFCTR=0,IBDFDAYS=+$P(IBDFNODE,"^",7)
124 F Q:IBDFCTR=IBDFDAYS D
125 .S IBDFDATE=$$FMADD^XLFDT(IBDFDATE,1)
126 .I IBDFINST["W" Q:$$WEEKEND(IBDFDATE)
127 .I IBDFINST["H" Q:$$HOLIDAY(IBDFDATE)
128 .I IBDFINST["I" Q:$$WEEKEND(IBDFDATE)!($$HOLIDAY(IBDFDATE))
129 .S IBDFCTR=IBDFCTR+1
130 S IBDFARY(IBDFDATE)=""
131 Q
132 ;
133WEEKEND(DATE) ;
134 ; -- DATE (defaulted to current date if not passed)
135 ; -- output = 1 if date is a weekend
136 I '$G(DATE) S DATE=$P($$NOW^XLFDT(),".")
137 I 60[$$DOW^XLFDT(DATE,1) Q 1
138 Q 0
139 ;
140HOLIDAY(DATE) ;
141 ; -- DATE (defaulted to current date if not passed)
142 ; -- output = 1 if date is a holiday
143 I '$G(DATE) S DATE=$P($$NOW^XLFDT(),".")
144 N X,Y,DIC
145 S DIC="^HOLIDAY(",DIC(0)="",X=+$P(DATE,".")
146 D ^DIC I +Y>0 Q 1
147 Q 0
148ZTDTH ; -- Set up the variable ZTDTH to pass the queue date time of the
149 ; queued job.
150 N IBDFJQ
151 I IBDFQT=2400!(IBDFQT=0000) D G DTIME
152 .I IBDFQTIM=2400 S IBDFQTIM="0000"
153 .I IBDFQTIM=IBDFQT S IBDFJQ=IBDFQDT Q
154 .S IBDFJQ=IBDFQD_"."_IBDFQTIM
155 I IBDFQTIM>IBDFQT S IBDFJQ=IBDFQD_"."_IBDFQTIM
156 I IBDFQTIM<IBDFQT S X1=IBDFQDT,X2=1 D C^%DTC S IBDFJQ=$P(X,".")_"."_IBDFQTIM
157 I IBDFQTIM=IBDFQT S IBDFJQ=IBDFQDT
158DTIME I IBDFJQ]"" S ZTDTH=$$FMTH^XLFDT(IBDFJQ)
159 Q
Note: See TracBrowser for help on using the repository browser.