DVBHQDB ;ISC-ALBANY/PKE-HINQ Queue batch processs ;8/4/87 18:04 ; 5/10/01 10:36am
;;4.0;HINQ;**12,15,20,33,34,38,55**;03/25/92
S X="A" X ^%ZOSF("LPC") K X
I $D(DUZ)#2'=1 W !,"User DUZ not defined" Q
I $D(^VA(200,DUZ,.1)) S DVBNUM=$P(^(.1),"^",9) I DVBNUM
E W !," HINQ Employee Number not in New Person file",!," Notify System Manager",! G EX
S U="^" W !,"When you enter your HINQ password all 'P'ending",!,"requests in the Suspense file will be generated.",!
I $D(^DVB(395,1,"HQ")),'$D(^DVB(395.5,"AD","P")) W !!,?$X+10,"No requests Pending",! H 3 G EX
PASS 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
;VBA has changed the format of the HINQ password to allow numbers and
;special characters - DVB*4*55,ERC
I $D(DVBP),$L(DVBP)=4
E G EX
;
DEV S DVBIP=$P($G(^DVB(395,1,"HQIP")),"^",1)
I DVBIP,DVBIP?1.3N1P1.3N1P1.3N1P1.3N
E W !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395" H 3 G EX
S DVBDEV=""
S X=7 F Z=1:1:4 S X=X_(100-$A(DVBP,Z))
U IO(0) W ?$X+10,"Direct Requests Queued "
D TSK,^%ZTLOAD W:$G(ZTSK) " #",ZTSK G EX
QUE ;entry from taskman, lock to prevent more than one job at a time
L +^DVB("DVBHINQ BATCH"):9 E H 33 S DVBABORT=1,DVBTSK=ZTSK D REQ G EX
S DVBABORT=0,DVBP=DVBDAY I '$D(^DVB(395.5,"AD","P")) G EX
I ('$D(DVBNUM)),('$D(DVBP)) G EX
S U="^",DVBABORT=1,DVBTSK=ZTSK D ENTSK^DVBHQDL I DVBABORT D REQ,BYEF G EX
S X=DVBP,DVBP="" D UTIL,COD,BYPASS,BYE,MAIL,22,UTIL I DVBABORT,'$D(DVBBADP) D REQ G EX
;
G EX
;
COD 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)))
Q
BYPASS U IO S (DFN,DVBCS,DVBACT,DVBCT,DVBECT)=0,DVBPCT=1
;
LIST Q:'$D(^DVB(395.5,"AD","P"))
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
Q
;
CHK I DVBABORT D BYE,MAIL G EX
Q
;
MAIL S DVBDFN=0
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
;nopend
Q
; first a summary
;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
MAL I $D(X)>9,$D(^DPT(DVBDFN,0)) DO
.K DVBERR D A^DVBHQST ;errs
.D A^DVBHIQR ;variables
.I '$P(^DVB(395.5,DVBDFN,0),"^",6) DO
..I '$D(DVBERR),'$D(DVBNETER),'$D(DVBABREV) S DFN=DVBDFN D EN^DVBHT1
..K DVBDIQ
.I $D(^DVB(395,1,0)),$P(^(0),"^",4) D EN^DVBHIQM Q ;mail messages
.I $D(^DVB(395,1,0)),$P(^(0),"^",4)=""!($P(^(0),"^",4)=0) D CLEAN^DVBHUTL1
Q
TSK S DVBDAY=$E(X,1,7)_"."_$E(X,8,9) X ^%ZOSF("UCI") S ZTUCI=Y
S ZTRTN="QUE^DVBHQDB",ZTIO=DVBDEV,ZTDTH=$H
TSK1 F J="DVBDAY","DVBNUM","DVBDEV" S ZTSAVE(J)=""
S ZTDESC="This job is to process the HINQ Suspense file."
Q
;
REQ 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)
I DVBATOCT>(DVBATOLM-1)!(DVBAUTO=0) Q
D ^DVBHQTM S X1=$P($H,",") I $D(DVBSTOP) S X1=X1+1,X2=28800-(DVBDIFF*3600)
E S X2=$P($H,",",2)
;Requeue task in 3 hours: DVB*38 MLR 5.10.01
I $G(DVBVBA)="NO" S X2=X2+10800 K DVBVBA
;S X2=X2+(300),ZTDTH=X1_","_X2
S X2=X2+($S(DVBABORT=99:60,1:300)),ZTDTH=X1_","_X2
S ZTIO=DVBDEV,$P(^DVB(395,1,"HQ"),U,9)=DVBATOCT+1,ZTRTN="QUE^DVBHQDB"
D TSK1,^%ZTLOAD
Q
EX ;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
D KILL^XUSCLEAN
L -^DVB("DVBHINQ BATCH") D CLOSE^%ZISTCP Q
;
BYEF I IO']"" Q
U IO F Z=1:1:30 I $D(X(Z)),X(Z)["???" I DVBLOG'["VHA" W "BYEF",$C(13) Q
E W "$%$DIS",$C(13),! Q
F Z=1:1:6 R X1:1 Q:'$T
Q
BYE I DVBLOG'["VHA" U IO W "$$$BYEF",$C(13) F G=1:1:9 R X1:3 Q:'$T
I DVBLOG["VHA" U IO W "$%$DIS",$C(13),! F G=1:1:6 R X1:1 Q:'$T I X1["0900 BYE" Q
Q
UTIL K ^TMP("DVBHINQ",$J) Q
; leaves mini open but signs off VBA
; then mails responses and closes mini
ST K:DVBSZ=1 ^DVB(395.5,DVBDFN,"RS") I '$D(^DVB(395.5,DVBDFN,"RS",0)) S ^(0)="^395.512A^^"
S $P(^DVB(395.5,DVBDFN,"RS",0),U,3,4)=DVBSZ_"^"_DVBSZ,^(DVBSZ,0)=X(DVBSZ) Q
;
22 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:"")
D ^XMB K DVBTE,DVBCT,XMSUB,XMTEXT,XMY,N,DVBY Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQDB 4608 printed Dec 13, 2024@01:58:36 Page 2
DVBHQDB ;ISC-ALBANY/PKE-HINQ Queue batch processs ;8/4/87 18:04 ; 5/10/01 10:36am
+1 ;;4.0;HINQ;**12,15,20,33,34,38,55**;03/25/92
+2 SET X="A"
XECUTE ^%ZOSF("LPC")
KILL X
+3 IF $DATA(DUZ)#2'=1
WRITE !,"User DUZ not defined"
QUIT
+4 IF $DATA(^VA(200,DUZ,.1))
SET DVBNUM=$PIECE(^(.1),"^",9)
IF DVBNUM
+5 IF '$TEST
WRITE !," HINQ Employee Number not in New Person file",!," Notify System Manager",!
GOTO EX
+6 SET U="^"
WRITE !,"When you enter your HINQ password all 'P'ending",!,"requests in the Suspense file will be generated.",!
+7 IF $DATA(^DVB(395,1,"HQ"))
IF '$DATA(^DVB(395.5,"AD","P"))
WRITE !!,?$X+10,"No requests Pending",!
HANG 3
GOTO EX
PASS XECUTE ^%ZOSF("EOFF")
READ !,"Enter HINQ PASSWORD: ",DVBP:DTIME
XECUTE ^%ZOSF("EON")
if '$TEST!("^."[DVBP)
QUIT
SET X=DVBP
XECUTE ^DD("FUNC",13,1)
SET DVBP=X
IF DVBP'?4E
WRITE "? ",!,$CHAR(7),"Please enter 4 characters."
GOTO PASS
+1 ;VBA has changed the format of the HINQ password to allow numbers and
+2 ;special characters - DVB*4*55,ERC
+3 IF $DATA(DVBP)
IF $LENGTH(DVBP)=4
+4 IF '$TEST
GOTO EX
+5 ;
DEV SET DVBIP=$PIECE($GET(^DVB(395,1,"HQIP")),"^",1)
+1 IF DVBIP
IF DVBIP?1.3N1P1.3N1P1.3N1P1.3N
+2 IF '$TEST
WRITE !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395"
HANG 3
GOTO EX
+3 SET DVBDEV=""
+4 SET X=7
FOR Z=1:1:4
SET X=X_(100-$ASCII(DVBP,Z))
+5 USE IO(0)
WRITE ?$X+10,"Direct Requests Queued "
+6 DO TSK
DO ^%ZTLOAD
if $GET(ZTSK)
WRITE " #",ZTSK
GOTO EX
QUE ;entry from taskman, lock to prevent more than one job at a time
+1 LOCK +^DVB("DVBHINQ BATCH"):9
IF '$TEST
HANG 33
SET DVBABORT=1
SET DVBTSK=ZTSK
DO REQ
GOTO EX
+2 SET DVBABORT=0
SET DVBP=DVBDAY
IF '$DATA(^DVB(395.5,"AD","P"))
GOTO EX
+3 IF ('$DATA(DVBNUM))
IF ('$DATA(DVBP))
GOTO EX
+4 SET U="^"
SET DVBABORT=1
SET DVBTSK=ZTSK
DO ENTSK^DVBHQDL
IF DVBABORT
DO REQ
DO BYEF
GOTO EX
+5 SET X=DVBP
SET DVBP=""
DO UTIL
DO COD
DO BYPASS
DO BYE
DO MAIL
DO 22
DO UTIL
IF DVBABORT
IF '$DATA(DVBBADP)
DO REQ
GOTO EX
+6 ;
+7 GOTO EX
+8 ;
COD SET X=$EXTRACT(X,2,7)_$EXTRACT(X,9,10)
FOR Z=1:2:8
SET DVBP=DVBP_$CHAR((100-$EXTRACT(X,Z,Z+1)))
+1 QUIT
BYPASS USE IO
SET (DFN,DVBCS,DVBACT,DVBCT,DVBECT)=0
SET DVBPCT=1
+1 ;
LIST if '$DATA(^DVB(395.5,"AD","P"))
QUIT
+1 FOR DVBCT=1:1
SET DFN=$ORDER(^DVB(395.5,"AD","P",DFN))
if 'DFN
QUIT
IF $DATA(^DVB(395.5,DFN,0))
IF "PV"[$PIECE(^(0),"^",4)
KILL Y(0),Y,DVBNAM,DVBSTN,DVBZ
DO BYPASS1^DVBHIQD
if $DATA(DVBZ)
DO MES^DVBHQD1
if 'DFN!(DVBABORT=3)
QUIT
IF DVBCT>49
SET DFN=0
SET DVBABORT=99
QUIT
+2 QUIT
+3 ;
CHK IF DVBABORT
DO BYE
DO MAIL
GOTO EX
+1 QUIT
+2 ;
MAIL SET DVBDFN=0
+1 FOR
SET DVBDFN=$ORDER(^TMP("DVBHINQ",$JOB,DVBDFN))
SET DVBCS=0
if 'DVBDFN
QUIT
KILL X
SET DVBSZ=0
FOR
SET DVBSZ=$ORDER(^TMP("DVBHINQ",$JOB,DVBDFN,DVBSZ))
if DVBSZ
SET X(DVBSZ)=^(DVBSZ)
if 'DVBSZ
DO MAL
DO SC^DVBHQST
if 'DVBSZ
QUIT
DO ST
+2 ;nopend
+3 QUIT
+4 ; first a summary
+5 ;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
MAL IF $DATA(X)>9
IF $DATA(^DPT(DVBDFN,0))
Begin DoDot:1
+1 ;errs
KILL DVBERR
DO A^DVBHQST
+2 ;variables
DO A^DVBHIQR
+3 IF '$PIECE(^DVB(395.5,DVBDFN,0),"^",6)
Begin DoDot:2
+4 IF '$DATA(DVBERR)
IF '$DATA(DVBNETER)
IF '$DATA(DVBABREV)
SET DFN=DVBDFN
DO EN^DVBHT1
+5 KILL DVBDIQ
End DoDot:2
+6 ;mail messages
IF $DATA(^DVB(395,1,0))
IF $PIECE(^(0),"^",4)
DO EN^DVBHIQM
QUIT
+7 IF $DATA(^DVB(395,1,0))
IF $PIECE(^(0),"^",4)=""!($PIECE(^(0),"^",4)=0)
DO CLEAN^DVBHUTL1
End DoDot:1
+8 QUIT
TSK SET DVBDAY=$EXTRACT(X,1,7)_"."_$EXTRACT(X,8,9)
XECUTE ^%ZOSF("UCI")
SET ZTUCI=Y
+1 SET ZTRTN="QUE^DVBHQDB"
SET ZTIO=DVBDEV
SET ZTDTH=$HOROLOG
TSK1 FOR J="DVBDAY","DVBNUM","DVBDEV"
SET ZTSAVE(J)=""
+1 SET ZTDESC="This job is to process the HINQ Suspense file."
+2 QUIT
+3 ;
REQ if '$DATA(DVBTSK)
QUIT
SET DVBAUTO=$PIECE(^DVB(395,1,"HQ"),U,7)
SET DVBATOLM=$PIECE(^("HQ"),U,8)
SET DVBATOCT=$PIECE(^("HQ"),U,9)
SET DVBDIFF=+$PIECE(^("HQ"),U,12)
+1 IF DVBATOCT>(DVBATOLM-1)!(DVBAUTO=0)
QUIT
+2 DO ^DVBHQTM
SET X1=$PIECE($HOROLOG,",")
IF $DATA(DVBSTOP)
SET X1=X1+1
SET X2=28800-(DVBDIFF*3600)
+3 IF '$TEST
SET X2=$PIECE($HOROLOG,",",2)
+4 ;Requeue task in 3 hours: DVB*38 MLR 5.10.01
+5 IF $GET(DVBVBA)="NO"
SET X2=X2+10800
KILL DVBVBA
+6 ;S X2=X2+(300),ZTDTH=X1_","_X2
+7 SET X2=X2+($SELECT(DVBABORT=99:60,1:300))
SET ZTDTH=X1_","_X2
+8 SET ZTIO=DVBDEV
SET $PIECE(^DVB(395,1,"HQ"),U,9)=DVBATOCT+1
SET ZTRTN="QUE^DVBHQDB"
+9 DO TSK1
DO ^%ZTLOAD
+10 QUIT
EX ;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
+1 DO KILL^XUSCLEAN
+2 LOCK -^DVB("DVBHINQ BATCH")
DO CLOSE^%ZISTCP
QUIT
+3 ;
BYEF IF IO']""
QUIT
+1 USE IO
FOR Z=1:1:30
IF $DATA(X(Z))
IF X(Z)["???"
IF DVBLOG'["VHA"
WRITE "BYEF",$CHAR(13)
QUIT
+2 IF '$TEST
WRITE "$%$DIS",$CHAR(13),!
QUIT
+3 FOR Z=1:1:6
READ X1:1
if '$TEST
QUIT
+4 QUIT
BYE IF DVBLOG'["VHA"
USE IO
WRITE "$$$BYEF",$CHAR(13)
FOR G=1:1:9
READ X1:3
if '$TEST
QUIT
+1 IF DVBLOG["VHA"
USE IO
WRITE "$%$DIS",$CHAR(13),!
FOR G=1:1:6
READ X1:1
if '$TEST
QUIT
IF X1["0900 BYE"
QUIT
+2 QUIT
UTIL KILL ^TMP("DVBHINQ",$JOB)
QUIT
+1 ; leaves mini open but signs off VBA
+2 ; then mails responses and closes mini
ST if DVBSZ=1
KILL ^DVB(395.5,DVBDFN,"RS")
IF '$DATA(^DVB(395.5,DVBDFN,"RS",0))
SET ^(0)="^395.512A^^"
+1 SET $PIECE(^DVB(395.5,DVBDFN,"RS",0),U,3,4)=DVBSZ_"^"_DVBSZ
SET ^(DVBSZ,0)=X(DVBSZ)
QUIT
+2 ;
22 SET XMB="DVB HINQ RESPONSE"
SET XMB(1)=DVBCT
SET XMB(2)=DVBECT
SET XMTEXT="DVBTXT("
SET XMB(3)=DVBACT
SET XMB(4)=DVBCT-DVBECT-DVBACT
SET XMB(5)=$SELECT(XMB(3):"(CHECK MAIL MESSAGES)",1:"")
+1 DO ^XMB
KILL DVBTE,DVBCT,XMSUB,XMTEXT,XMY,N,DVBY
QUIT
