source: FOIAVistA/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQDB.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1DVBHQDB ;ISC-ALBANY/PKE-HINQ Queue batch processs ;8/4/87 18:04 ; 5/10/01 10:36am
2 ;;4.0;HINQ;**12,15,20,33,34,38,55**;03/25/92
3 S X="A" X ^%ZOSF("LPC") K X
4 I $D(DUZ)#2'=1 W !,"User DUZ not defined" Q
5 I $D(^VA(200,DUZ,.1)) S DVBNUM=$P(^(.1),"^",9) I DVBNUM
6 E W !," HINQ Employee Number not in New Person file",!," Notify System Manager",! G EX
7 S U="^" W !,"When you enter your HINQ password all 'P'ending",!,"requests in the Suspense file will be generated.",!
8 I $D(^DVB(395,1,"HQ")),'$D(^DVB(395.5,"AD","P")) W !!,?$X+10,"No requests Pending",! H 3 G EX
9PASS X ^%ZOSF("EOFF") R !,"Enter HINQ PASSWORD: ",DVBP:DTIME X ^%ZOSF("EON") Q:'$T!("^."[DVBP) S X=DVBP X ^DD("FUNC",13,1) S DVBP=X I DVBP'?4E W "? ",!,$C(7),"Please enter 4 characters." G PASS
10 ;VBA has changed the format of the HINQ password to allow numbers and
11 ;special characters - DVB*4*55,ERC
12 I $D(DVBP),$L(DVBP)=4
13 E G EX
14 ;
15DEV S DVBIP=$P($G(^DVB(395,1,"HQIP")),"^",1)
16 I DVBIP,DVBIP?1.3N1P1.3N1P1.3N1P1.3N
17 E W !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395" H 3 G EX
18 S DVBDEV=""
19 S X=7 F Z=1:1:4 S X=X_(100-$A(DVBP,Z))
20 U IO(0) W ?$X+10,"Direct Requests Queued "
21 D TSK,^%ZTLOAD W:$G(ZTSK) " #",ZTSK G EX
22QUE ;entry from taskman, lock to prevent more than one job at a time
23 L +^DVB("DVBHINQ BATCH"):9 E H 33 S DVBABORT=1,DVBTSK=ZTSK D REQ G EX
24 S DVBABORT=0,DVBP=DVBDAY I '$D(^DVB(395.5,"AD","P")) G EX
25 I ('$D(DVBNUM)),('$D(DVBP)) G EX
26 S U="^",DVBABORT=1,DVBTSK=ZTSK D ENTSK^DVBHQDL I DVBABORT D REQ,BYEF G EX
27 S X=DVBP,DVBP="" D UTIL,COD,BYPASS,BYE,MAIL,22,UTIL I DVBABORT,'$D(DVBBADP) D REQ G EX
28 ;
29 G EX
30 ;
31COD S X=$E(X,2,7)_$E(X,9,10) F Z=1:2:8 S DVBP=DVBP_$C((100-$E(X,Z,Z+1)))
32 Q
33BYPASS U IO S (DFN,DVBCS,DVBACT,DVBCT,DVBECT)=0,DVBPCT=1
34 ;
35LIST Q:'$D(^DVB(395.5,"AD","P"))
36 F DVBCT=1:1 S DFN=$O(^DVB(395.5,"AD","P",DFN)) Q:'DFN I $D(^DVB(395.5,DFN,0)),"PV"[$P(^(0),"^",4) K Y(0),Y,DVBNAM,DVBSTN,DVBZ D BYPASS1^DVBHIQD D:$D(DVBZ) MES^DVBHQD1 Q:'DFN!(DVBABORT=3) I DVBCT>49 S DFN=0,DVBABORT=99 Q
37 Q
38 ;
39CHK I DVBABORT D BYE,MAIL G EX
40 Q
41 ;
42MAIL S DVBDFN=0
43 F S DVBDFN=$O(^TMP("DVBHINQ",$J,DVBDFN)),DVBCS=0 Q:'DVBDFN K X S DVBSZ=0 F S DVBSZ=$O(^TMP("DVBHINQ",$J,DVBDFN,DVBSZ)) S:DVBSZ X(DVBSZ)=^(DVBSZ) D MAL:'DVBSZ,SC^DVBHQST Q:'DVBSZ D ST
44 ;nopend
45 Q
46 ; first a summary
47 ;I $D(X)>9,$D(^DPT(DVBDFN,0)) D A^DVBHQST I $D(^DVB(395,1,0)),$P(^(0),U,4) D A^DVBHIQR,EN^DVBHIQM
48MAL I $D(X)>9,$D(^DPT(DVBDFN,0)) DO
49 .K DVBERR D A^DVBHQST ;errs
50 .D A^DVBHIQR ;variables
51 .I '$P(^DVB(395.5,DVBDFN,0),"^",6) DO
52 ..I '$D(DVBERR),'$D(DVBNETER),'$D(DVBABREV) S DFN=DVBDFN D EN^DVBHT1
53 ..K DVBDIQ
54 .I $D(^DVB(395,1,0)),$P(^(0),"^",4) D EN^DVBHIQM Q ;mail messages
55 .I $D(^DVB(395,1,0)),$P(^(0),"^",4)=""!($P(^(0),"^",4)=0) D CLEAN^DVBHUTL1
56 Q
57TSK S DVBDAY=$E(X,1,7)_"."_$E(X,8,9) X ^%ZOSF("UCI") S ZTUCI=Y
58 S ZTRTN="QUE^DVBHQDB",ZTIO=DVBDEV,ZTDTH=$H
59TSK1 F J="DVBDAY","DVBNUM","DVBDEV" S ZTSAVE(J)=""
60 S ZTDESC="This job is to process the HINQ Suspense file."
61 Q
62 ;
63REQ Q:'$D(DVBTSK) S DVBAUTO=$P(^DVB(395,1,"HQ"),U,7),DVBATOLM=$P(^("HQ"),U,8),DVBATOCT=$P(^("HQ"),U,9),DVBDIFF=+$P(^("HQ"),U,12)
64 I DVBATOCT>(DVBATOLM-1)!(DVBAUTO=0) Q
65 D ^DVBHQTM S X1=$P($H,",") I $D(DVBSTOP) S X1=X1+1,X2=28800-(DVBDIFF*3600)
66 E S X2=$P($H,",",2)
67 ;Requeue task in 3 hours: DVB*38 MLR 5.10.01
68 I $G(DVBVBA)="NO" S X2=X2+10800 K DVBVBA
69 ;S X2=X2+(300),ZTDTH=X1_","_X2
70 S X2=X2+($S(DVBABORT=99:60,1:300)),ZTDTH=X1_","_X2
71 S ZTIO=DVBDEV,$P(^DVB(395,1,"HQ"),U,9)=DVBATOCT+1,ZTRTN="QUE^DVBHQDB"
72 D TSK1,^%ZTLOAD
73 Q
74EX ;K DVBAS,DVBOS,ZTSK,DVBNUM,XH,X,Y,Y(0),Z,Z1,DVBATOCT,DVBATOLM,DVBAUTO,DVBDFN,DVBBADP,DVBDEV,DVBDAY,DVBT,DVBP,DVBUCI,DFN,DVBABORT,DVBTSK,DVBDIFF,DVBSTOP,J,ZTIO QUIT
75 D KILL^XUSCLEAN
76 L -^DVB("DVBHINQ BATCH") D CLOSE^%ZISTCP Q
77 ;
78BYEF I IO']"" Q
79 U IO F Z=1:1:30 I $D(X(Z)),X(Z)["???" I DVBLOG'["VHA" W "BYEF",$C(13) Q
80 E W "$%$DIS",$C(13),! Q
81 F Z=1:1:6 R X1:1 Q:'$T
82 Q
83BYE I DVBLOG'["VHA" U IO W "$$$BYEF",$C(13) F G=1:1:9 R X1:3 Q:'$T
84 I DVBLOG["VHA" U IO W "$%$DIS",$C(13),! F G=1:1:6 R X1:1 Q:'$T I X1["0900 BYE" Q
85 Q
86UTIL K ^TMP("DVBHINQ",$J) Q
87 ; leaves mini open but signs off VBA
88 ; then mails responses and closes mini
89ST K:DVBSZ=1 ^DVB(395.5,DVBDFN,"RS") I '$D(^DVB(395.5,DVBDFN,"RS",0)) S ^(0)="^395.512A^^"
90 S $P(^DVB(395.5,DVBDFN,"RS",0),U,3,4)=DVBSZ_"^"_DVBSZ,^(DVBSZ,0)=X(DVBSZ) Q
91 ;
9222 S XMB="DVB HINQ RESPONSE",XMB(1)=DVBCT,XMB(2)=DVBECT,XMTEXT="DVBTXT(",XMB(3)=DVBACT,XMB(4)=DVBCT-DVBECT-DVBACT,XMB(5)=$S(XMB(3):"(CHECK MAIL MESSAGES)",1:"")
93 D ^XMB K DVBTE,DVBCT,XMSUB,XMTEXT,XMY,N,DVBY Q
Note: See TracBrowser for help on using the repository browser.