VENPCCP ; IHS/OIT/GIS - PRINT DEAMON - MANAGE BACKGROUND PRINTING ; [ 03/03/09 5:46 PM ]
;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
;
;
;
TASK ; EP - PRINT DEAMON ; THERE SHOULD ONLY BE 1 PRINT DEAMON PROCESS RUNNING AT A TIME
I $D(^TMP("VEN TASK",$J)) X ("J K"_"T^VENPCCP") Q ; IT LOOKS LIKE THERE ALREADY IS A PRINT DEAMON ALREADY RUNNING IN THIS PARTITION!
E D KILLTASK ; INITIAL CLEANUP ; MAKE SURE NO OTHER PRINT DEAMON PROCESSES ARE RUNNING
D ^VENPCCP1
K ^TMP("VEN TASK",$J) D KILLTASK Q ; FINAL CLEANUP ; STOP ALL PRINT DEAMON PROCESSES
;
; ---------------------------------------------------------
;
SEND(SOCKET,IP,IPA) ; EP - FOR SENDING A RECORD TO THE PRINT SERVICE
; SEND(SOCKET,IP,IPA,PGIEN,MRPFLAG) ; EP FOR SENDING A RECORD TO THE PRINT SERVICE
; REC MUST EXIST AS AN ARRAY (VER 2.5) OR A LOCAL VARIABLE (PREVIOUS VERSIONS)
; IP IS THE TCP/IP ADDRESS. IPA IS THE ALTERNATE IP ADDRESS (IPA IS OPTIONAL)
; SOCKET IS THE TCP SOCKET NUMBER ON THIS MACHINE
; REC IS THE RECORD
; THE RECORD MUST BE '^' DELIMITED. FIRST PIECE: HEADER NAME/MNEMONIC. SECOND PIECE: TEMPLATE NAME/MNEMONIC. THIRD PIECE: PRINTER DESTINATION. FOUTH PIECE: ENVIRONMANTAL INFO OTHER PIECES: DATA
; THIS FUNCTION RETURNS '1' IF THE TRANSMISSION WAS SUCCESSFUL OR AN ERROR CODE IF IT WAS UNSUCCESSFUL
; UPDATED TO SUPPERT THE VER 2.5 PRINT SERVICE
;
CHK I $G(SOCKET),$L(IP),$D(REC)
E D REG^VENPCCP2(10,"MISSING/INVALID CONFIGURATION PARPMETERS") Q 0
N %,N,ACK,ERR,STOP,LEN,PCE,SEX,SSN,VCN,ELIG,RSTG,OK,I
N MAXPCE,CKSUM,TRY,CACHE,BUFF,BLANK,LASTPCE,STOP,ECNT
S ECNT=0 ; INITIALIZE THE ERROR COUNTER
S CACHE=($$VEN^VENPCCU=2),BUFF=$S(CACHE:500,1:500)
I $D(SWAP) S (IP,IPA)=SWAP
JUMP25 I $G(VER25) G EVAR ; VER 2.5: THE REC ARRAY HAS ALREDY BEEN CREATED & CKSUM CALCULATED. NO BLANK LINE NECESSARY.
ADDBLANK S BLANK="",N=$L(REC,U) S $P(BLANK,U,N)="" S BLANK=$C(13,10)_BLANK,CKSUM=$L(REC)+$L(BLANK)
SPLIT F I=1:1 S %=$E(REC,1,BUFF),REC=$E(REC,(BUFF+1),99999) Q:%="" S REC(I)=%,LASTPCE=I+1
F I=LASTPCE:1 S %=$E(BLANK,1,BUFF),BLANK=$E(BLANK,(BUFF+1),99999) Q:%="" S REC(I)=%,MAXPCE=I
EVAR D VAR ; GET ENVIRONMENTAL VARIABLES
TRY S POP=$$OTCP^VENPCCP(IP,SOCKET) ; TRY TO OPEN TCP SOCKET TO THE PRINT SERVER
I POP,$D(SWAP)!(IP=IPA) D REG^VENPCCP2(1,"UNABLE TO ACCESS ANY PRINT SERVERS") Q 0
I POP D REG^VENPCCP2(4,"UNABLE TO ACCESS ONE OF THE PRINT SERVERS ("_IP_")") S (IP,SWAP)=IPA S @TMP="Unable to access one of the Print Servers" G TRY
S TRY=0
START W ("START"_U_CKSUM) W:$G(CACHE) ! K ACK ; START THE TRANSMISSION TO THE PRINT SERVER
R ACK:60
I $G(ACK)=1 G LOOP ; SUCCESSFUL START!
; IF YOU GET TO THIS POINT, SOMETHING HAS GONE WRONG...
I $G(ACK)=-5 D G:'$D(@TMP) NOTOPEN G:TRY'>20 START Q
. S TRY=TRY+1
. I TRY>20 Q
. H 5
. I '$D(@TMP) Q
. S @TMP="Print Service busy. Will attempt to connect for another "_(100-(5*TRY))_" seconds"
. Q
NOTOPEN D CTCP ; CLOSE TCP SOCKET AFTER START FAILURE
I '$D(@TMP) Q "EXTERNAL HALT"
I $G(ACK)="" D REG^VENPCCP2(1,"Unable to connect to a Print Server") Q 0
I $G(ACK)=-5 D REG^VENPCCP2(2,"Print Service was busy, and it timed out") G N1
D REG^VENPCCP2(2,"Print service reports a startup error ("_$G(ACK)_")")
N1 I $G(SWAP)!(IP=IPA) Q 0 ; FAILED TO START PRINT PROCESS!
S (SWAP,IP)=IPA G TRY
;
LOOP S PCE=0 K STOP ; DATA TRANSMISSION FROM RPMS TO PCC+ PRINT SVC
S @TMP="Transmitting data to PCC+ print service..."
F S PCE=$O(REC(PCE)) Q:'PCE D I $D(STOP) Q ; TRANSMISSION LOOP: DATA SENT IN CHUNKS.
. S REC=REC(PCE)
. W REC W:CACHE ! K ACK
. R ACK:60 ; TYPICALLY, WE GET SUB-SECOND RESPONSE TIME
. I '$D(ACK) S STOP=0 Q
. I $E(ACK)=1 F Q:$E(ACK,2)'=1 S ACK=$E(ACK,2,99)
. I ACK'=1 S STOP=1
. Q
LOOPFAIL I $D(STOP) D Q 0 ; PRINT SERVICE STARTS RECEPTION, BUT DATA TRANSMISSION FAILS. MANAGE THE ERROR.
. D CTCP
. I 'STOP D REG^VENPCCP2(1,"Print Service starts but then does not respond") Q
. D REG^VENPCCP2(1,"Print Service starts, but then it reports a data transmission failure")
. Q
MERGE S @TMP=(MSG_" Starting mail merge") ; START MAIL MERGE
W "STOP" W:CACHE ! K ACK ; SEND MESSAGE: "STOP" = ALL DATA SENT, START TO GENERATE THE MERGED DOCUMENT
R ACK:60 ; IF THINGS ARE WORKING NORMALLY, THE ACK SHOULD COME BACK WITHIN A FEW SECONDS
CLOSESVS D CTCP ; CLOSE THE TCP CONNECTION
SUCCESS I $G(ACK)=0 S @TMP=(MSG_" Success!!!") Q 1
RETRY I ACK=-1 S ECNT=ECNT+1 I ECNT<2 D G TRY ; PROBABLY A COM PROBLEM. TRY 2 TIMES ; PATCHED BY GIS/OIT 5/15/08 ; PCC+ 2.6 PATCH 1 ; WORK AROUND FOR COM ERROR
. S @TMP=(MSG_" Retry #"_ECNT)
. I $G(IPA)'="",IPA'=IP S IP=IPA ; IF POSSIBLE, TRY A DIFFERENT PRINT SERVER
. H 1
. Q
MERGFAIL D MERGFAIL^VENPCCP2($G(ACK),$G(MRPFLAG),PGIEN) ; MERGE HAS FAILED. MANAGE THE ERROR.
Q 0
;
VAR ; EP-GET MISC VARS REQUIRED FOR ERROR PROCESSING
; GET ENVIRONMENTAL VARS: VISIT, DUZ, DUZ(2), DFN, DUZ(0), VENDEV, DEFEF, MRPFLG
I '$G(VER25) D VARS Q
N CNT,STG,X,Y,Z,%,VE,VD,VP
S (VE,VD,VP)=""
S (CNT,CKSUM,MAXPCE)=0
F S CNT=$O(REC(CNT)) Q:'CNT D
. S CKSUM=CKSUM+$L(REC(CNT))
. S MAXPCE=CNT
. S STG=REC(CNT)_$G(REC(CNT+1))
. I 'VE F X="PRINTER","printer" D ; GET ENVIRONMENTAL VARIABLES
.. S Y="^"_X_$C(30)
.. I STG'[Y Q
.. S %=$P(STG,Y,2),%=$P(%,U) ; DATA STRING
.. I $L(%,";")'>5 Q ; INCOMPLETE DATA STRING - WAIT FOR NEXT ITERATION
.. S VISIT=$P(%,";"),DFN=$P(%,";",4),VENDEV=$P(%,U,6),VE=1
.. S %=$C(68,85,90)
.. S @%=$P(%,";",2),@%@(2)=$P(%,";",3),@%@(0)=$P(%,U,5)
.. Q
. I 'VD F X="TEMPLATE","template" D ; GET TEMPLATE
.. S Y="^"_X_$C(30)
.. I STG'[Y Q
.. S %=$P(STG,Y,2) ; DATA STRING
.. I %'[U Q ; INCOMPLETE, WAIT FOR NEXT ITERATION
.. S %=$P(%,U)
.. S DEFEF="",VD=1
.. I '$L(%) Q
.. S Z=0
.. F S Z=$O(^VEN(7.41,Z)) Q:'Z I $P($G(^(Z,0)),U,3)=% S DEFEF=Z Q
.. Q
. I 'VP F X="GROUP","group" D ; GET PRINT GROUP
.. S Y="^"_X_$C(30)
.. I STG'[Y Q
.. S %=$P(STG,Y,2) ; DATA STRING
.. I %'[U Q ; INCOMPLETE, WAIT FOR NEXT ITERATION
.. S %=$P(%,U)
.. S PGIEN="",MRPFLAG=0,VP=1
.. S PGIEN=$O(^VEN(7.4,"B",%,0)) I 'PGIEN Q
.. I $$MRP^VENPCCU=$P($G(^VEN(7.4,PGIEN,0)),U) S MRPFLAG=1
.. Q
. Q
Q
;
VARS ; EP-OLD WAY OF GETTING ENVIRONMENTAL VARS TO POPULATE ERROR MSG FILE
N %,X,Z
FMVARS S %=$P(REC(1),U,4)
S Z=$C(68,85,90)
S VISIT=$P(%,";"),@Z=$P(%,";",2),@Z@(2)=$P(%,";",3),DFN=$P(%,";",4),@Z@(0)=$P(%,U,5),VENDEV=$P(%,U,6)
DEFEF S %=$P(REC(1),U,2),DEFEF="",Z=0 ; GET DEFAULT TEMPLTE IEN
F S Z=$O(^VEN(7.41,Z)) Q:'Z I $P($G(^(Z,0)),U,3)=% S DEFEF=Z Q
PGIEN S %=$P(REC(1),U,3),PGIEN="",MRPFLAG=0 ; GET PRINT GROUP IEN
I $L(%) S PGIEN=$O(^VEN(7.4,"B",%,0)) ; IDENTIFY PRINT GROUP IEN
MRPFLAG I $$MRP^VENPCCU=$P($G(^VEN(7.4,+$G(PGIEN),0)),U) S MRPFLAG=1 ; THIS DOCUMENT IS GOING TO THE MED REC PRINTER
Q
;
; -------------------------------------------------------------
;
; GENERIC PRINT DEAMON FUNCTIONS USED BY MANY ROUTINES
;
OPN(PATH,FILE,RW,EX) ; EP-CLEAN HFS OPEN, USE, EXECUTE, CLOSE
N DEV,POP,TRY,F,CACHE
S F=PATH_FILE,POP=1,TRY=0,CACHE=($$VEN^VENPCCU=2)
OPN1 I 'CACHE X ("F DEV=51:1:54 O DEV:(F:RW):2 I $T S POP=0 U DEV X EX C DEV Q")
I CACHE D Q POP
. S RW=$S(RW="W":"WNS",1:"RS"),DEV=F
. X ("O"_" F:(RW):2")
. X ("I S POP=0 "_"U"_" F X EX "_"C"_" F")
. Q
I 'POP Q 0
; STOP TRYING IF STOP OPTION HAS BEEN SELECTED
I '$D(^TMP("VEN TASK",$J)) Q 2
S TRY=TRY+1 I TRY>5 Q 1
H 2 G OPN1
;
FIRST(PATH) ; EP-FIRST FILE IN THE PATH
I $$VEN^VENPCCU=2 X ("S RESULT=$"_"Z"_"SEARCH("""_PATH_"*.TXT"")") Q $P(RESULT,"\",$L(RESULT,"\"))
I $$OS^VENPCCU S RESULT=$$UNIX(PATH,"S RESULT="""" F R % Q:%="""" I %["".TXT""!(%["".txt"") S RESULT=% Q") Q RESULT
N X,PF
S PF=PATH_"*.TXT"
D FUNC("FIRST")
Q $P(X,U)
;
DEL(PATH,F) ; EP-FROM VENPCC2A - DELETE A FILE FROM THE PRINT QUEUE
I $$VEN^VENPCCU=2,$$OS^VENPCCU=1 X ("I $"_"Z"_"F(-1,""rm "_PATH_F_""")") Q ; UNIX/CACHE
I $$VEN^VENPCCU=2 X ("I $"_"Z"_"F(-1,""del "_PATH_F_""")") Q ; NT/CACHE
I $$OS^VENPCCU D UCMD("rm "_PATH_F) Q ; UNIX/MSM
N PF,X,%
S PF=PATH_F
D FUNC("DEL") ; NT/MSM
Q
;
COUNT(PATH) ; EP-COUNT FILES WAITING TO BE PROCESSED
N FILE,CNT
I $$VEN^VENPCCU=2 X ("F CNT=0:1 S FILE=$S('CNT:(PATH_""*.TXT""),1:"""") S FILE=$"_"Z"_"SEARCH(FILE) I '$L(FILE) Q") Q CNT
I $$OS^VENPCCU N RESULT,X S RESULT=$$UNIX(PATH,"S RESULT=0 F R X Q:'$L(X) I X["".TXT""!(X["".txt"") S RESULT=RESULT+1") Q RESULT
N PF,CNT
S PF=PATH_"*.TXT"
D FUNC("FIRST")
I '$L(X) Q 0
S CNT=1
COUNT1 D FUNC("NEXT")
I X="" Q CNT
S CNT=CNT+1
G COUNT1
;
FIND(PATH,TARGET) ;EP-RETURN A '1' IF A FILE EXISTS
N FILE
I $$VEN^VENPCCU=2 X ("S TARGET=$"_"Z"_"SEARCH(PATH_TARGET)") Q ($L(TARGET)>0)
I $$OS^VENPCCU N RESULT,X S RESULT=$$UNIX(PATH,"S RESULT=0 F R X Q:'$L(X) I $P(X,U)=TARGET S RESULT=1 Q") Q RESULT
N PF
S PF=PATH_TARGET
D FUNC("FIRST")
I '$L(X) Q 0
I $P(X,U)=TARGET Q 1
FIND1 X "S X=$"_"Z"_"OS(13,X)"
I X="" Q 0
I $P(X,U)=TARGET Q 1
G FIND1
;
UCMD(CMD) ;EP-UNIX COMMANDS
Q:'$L($G(CMD))
X ("I $$JOB"_"WAIT"_U_"%HOST"_"CMD(CMD)")
Q
;
UNIX(PATH,EX) ; EP-EXAMINE A UNIX DIRECTORY
N PATH2,PATHX,FILE,CMD,RESULT
S PATH2=$G(^VEN(7.5,CFIGIEN,3)),PATHX=$E(PATH,1,$L(PATH)-1),RESULT=""
S FILE="ven_"_+$J_".temp",CMD="ls "_PATHX_" > "_PATH2_FILE
D UCMD(CMD)
S POP=$$OPN(PATH2,FILE,"R",EX) I POP Q ""
D DEL(PATH2,FILE)
Q RESULT
;
OTCP(IP,SOCKET) ; EP-OPEN TCP
N IO,IOF,IOT,IOST,POP
I $$VEN^VENPCCU<2 D CALL^%ZISTCP(IP,SOCKET,10) Q POP
S POP=1 X ("O"_" ""|TCP|"_SOCKET_""":"""_IP_""":5") I $T S POP=0 X ("U"_" ""|TCP|"_SOCKET_"""")
Q POP
;
CTCP ; EP-CLOSE TCP
I $$VEN^VENPCCU<2 X ("C"_" 56") Q
I '$G(SOCKET) N SOCKET S SOCKET=$P($G(^VEN(7.5,$$CFG^VENPCCU,11)),U,3)
X ("C"_" ""|TCP|"_SOCKET_"""")
Q
;
FUNC(ACT) ; EP-MSM/NT FUNCTIONS
N %,Y
S %="S X=$"_"Z"_"O"
I ACT="FIRST" X (%_"S(12,PF,0)") Q
I ACT="NEXT" X (%_"S(13,X)") Q
I ACT="DEL",PF'["*." X (%_"S(2,PF)") Q
I ACT'="DEL" Q
D FUNC("FIRST") I X="" Q
I X[".txt"!(X[".TXT") S Y=X,PF=PATH_$P(X,U) D FUNC("DEL") S X=Y
F D FUNC("NEXT") Q:X="" I X[".txt"!(X[".TXT") S Y=X,PF=PATH_$P(X,U) D FUNC("DEL") S X=Y
Q
;
HOLD(FILE,PATH) ; EP-IF TRANSMISSION FAILS, PUT THE FILE SET AT THE BACK OF THE LINE
N X,N,M,%,F,R,CMD,STG,%
S N=$E(FILE,2,99)
F M="e","g","h","E","G","H" S F=(M_N) I $$FIND(PATH,F) D
. S R="z"_$E(F)_$E(F,3,99),STG=" "_PATH_F_" "_PATH_R
. I $$VEN^VENPCCU=2 S CMD="copy"_STG X ("S %=$"_"Z"_"F(-1,CMD)") D DEL(PATH,F) Q
. I $$OS^VENPCCU S CMD="cp"_STG D UCMD(CMD) D DEL(PATH,F) Q
. X ("S %=$"_"ZO"_"S(3,PATH_F,PATH_R)")
. Q
Q
;
KT H 3
KILLTASK ; EP - DEFINITIVE WAY TO STOP ALL INSTANCES OF THE PRINT DEAMON
N X
S X=0
F S X=$O(^TMP("VEN TASK",X)) Q:'X D ; MAKE SURE ALL PRINT DEAMON PROCESSES ARE SHUT DOWN
. K ^TMP("VEN TASK",X) ; INDIRECT WAY TO STOP ANOTHER PROCESS ; MSM
. I $P($G(^VEN(7.5,$$CFG^VENPCCU,0)),"^",5)=2 X ("S %=$Z"_"UTIL(4,X)") Q ; DIRECTLY STOP ANOTHER PRINT DEAMON PROCESS; CACHE ONLY
. Q
Q
;
VENPCCP ; IHS/OIT/GIS - PRINT DEAMON - MANAGE BACKGROUND PRINTING ; [ 03/03/09 5:46 PM ]
+1 ;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
+2 ;
+3 ;
+4 ;
TASK ; EP - PRINT DEAMON ; THERE SHOULD ONLY BE 1 PRINT DEAMON PROCESS RUNNING AT A TIME
+1 ; IT LOOKS LIKE THERE ALREADY IS A PRINT DEAMON ALREADY RUNNING IN THIS PARTITION!
IF $DATA(^TMP("VEN TASK",$JOB))
XECUTE ("J K"_"T^VENPCCP")
QUIT
+2 ; INITIAL CLEANUP ; MAKE SURE NO OTHER PRINT DEAMON PROCESSES ARE RUNNING
IF '$TEST
DO KILLTASK
+3 DO ^VENPCCP1
+4 ; FINAL CLEANUP ; STOP ALL PRINT DEAMON PROCESSES
KILL ^TMP("VEN TASK",$JOB)
DO KILLTASK
QUIT
+5 ;
+6 ; ---------------------------------------------------------
+7 ;
SEND(SOCKET,IP,IPA) ; EP - FOR SENDING A RECORD TO THE PRINT SERVICE
+1 ; SEND(SOCKET,IP,IPA,PGIEN,MRPFLAG) ; EP FOR SENDING A RECORD TO THE PRINT SERVICE
+2 ; REC MUST EXIST AS AN ARRAY (VER 2.5) OR A LOCAL VARIABLE (PREVIOUS VERSIONS)
+3 ; IP IS THE TCP/IP ADDRESS. IPA IS THE ALTERNATE IP ADDRESS (IPA IS OPTIONAL)
+4 ; SOCKET IS THE TCP SOCKET NUMBER ON THIS MACHINE
+5 ; REC IS THE RECORD
+6 ; THE RECORD MUST BE '^' DELIMITED. FIRST PIECE: HEADER NAME/MNEMONIC. SECOND PIECE: TEMPLATE NAME/MNEMONIC. THIRD PIECE: PRINTER DESTINATION. FOUTH PIECE: ENVIRONMANTAL INFO OTHER PIECES: DATA
+7 ; THIS FUNCTION RETURNS '1' IF THE TRANSMISSION WAS SUCCESSFUL OR AN ERROR CODE IF IT WAS UNSUCCESSFUL
+8 ; UPDATED TO SUPPERT THE VER 2.5 PRINT SERVICE
+9 ;
CHK IF $GET(SOCKET)
IF $LENGTH(IP)
IF $DATA(REC)
+1 IF '$TEST
DO REG^VENPCCP2(10,"MISSING/INVALID CONFIGURATION PARPMETERS")
QUIT 0
+2 NEW %,N,ACK,ERR,STOP,LEN,PCE,SEX,SSN,VCN,ELIG,RSTG,OK,I
+3 NEW MAXPCE,CKSUM,TRY,CACHE,BUFF,BLANK,LASTPCE,STOP,ECNT
+4 ; INITIALIZE THE ERROR COUNTER
SET ECNT=0
+5 SET CACHE=($$VEN^VENPCCU=2)
SET BUFF=$SELECT(CACHE:500,1:500)
+6 IF $DATA(SWAP)
SET (IP,IPA)=SWAP
JUMP25 ; VER 2.5: THE REC ARRAY HAS ALREDY BEEN CREATED & CKSUM CALCULATED. NO BLANK LINE NECESSARY.
IF $GET(VER25)
GOTO EVAR
ADDBLANK SET BLANK=""
SET N=$LENGTH(REC,U)
SET $PIECE(BLANK,U,N)=""
SET BLANK=$CHAR(13,10)_BLANK
SET CKSUM=$LENGTH(REC)+$LENGTH(BLANK)
SPLIT FOR I=1:1
SET %=$EXTRACT(REC,1,BUFF)
SET REC=$EXTRACT(REC,(BUFF+1),99999)
IF %=""
QUIT
SET REC(I)=%
SET LASTPCE=I+1
+1 FOR I=LASTPCE:1
SET %=$EXTRACT(BLANK,1,BUFF)
SET BLANK=$EXTRACT(BLANK,(BUFF+1),99999)
IF %=""
QUIT
SET REC(I)=%
SET MAXPCE=I
EVAR ; GET ENVIRONMENTAL VARIABLES
DO VAR
TRY ; TRY TO OPEN TCP SOCKET TO THE PRINT SERVER
SET POP=$$OTCP^VENPCCP(IP,SOCKET)
+1 IF POP
IF $DATA(SWAP)!(IP=IPA)
DO REG^VENPCCP2(1,"UNABLE TO ACCESS ANY PRINT SERVERS")
QUIT 0
+2 IF POP
DO REG^VENPCCP2(4,"UNABLE TO ACCESS ONE OF THE PRINT SERVERS ("_IP_")")
SET (IP,SWAP)=IPA
SET @TMP="Unable to access one of the Print Servers"
GOTO TRY
+3 SET TRY=0
START ; START THE TRANSMISSION TO THE PRINT SERVER
WRITE ("START"_U_CKSUM)
IF $GET(CACHE)
WRITE !
KILL ACK
+1 READ ACK:60
+2 ; SUCCESSFUL START!
IF $GET(ACK)=1
GOTO LOOP
+3 ; IF YOU GET TO THIS POINT, SOMETHING HAS GONE WRONG...
+4 IF $GET(ACK)=-5
Begin DoDot:1
+5 SET TRY=TRY+1
+6 IF TRY>20
QUIT
+7 HANG 5
+8 IF '$DATA(@TMP)
QUIT
+9 SET @TMP="Print Service busy. Will attempt to connect for another "_(100-(5*TRY))_" seconds"
+10 QUIT
End DoDot:1
IF '$DATA(@TMP)
GOTO NOTOPEN
IF TRY'>20
GOTO START
QUIT
NOTOPEN ; CLOSE TCP SOCKET AFTER START FAILURE
DO CTCP
+1 IF '$DATA(@TMP)
QUIT "EXTERNAL HALT"
+2 IF $GET(ACK)=""
DO REG^VENPCCP2(1,"Unable to connect to a Print Server")
QUIT 0
+3 IF $GET(ACK)=-5
DO REG^VENPCCP2(2,"Print Service was busy, and it timed out")
GOTO N1
+4 DO REG^VENPCCP2(2,"Print service reports a startup error ("_$GET(ACK)_")")
N1 ; FAILED TO START PRINT PROCESS!
IF $GET(SWAP)!(IP=IPA)
QUIT 0
+1 SET (SWAP,IP)=IPA
GOTO TRY
+2 ;
LOOP ; DATA TRANSMISSION FROM RPMS TO PCC+ PRINT SVC
SET PCE=0
KILL STOP
+1 SET @TMP="Transmitting data to PCC+ print service..."
+2 ; TRANSMISSION LOOP: DATA SENT IN CHUNKS.
FOR
SET PCE=$ORDER(REC(PCE))
IF 'PCE
QUIT
Begin DoDot:1
+3 SET REC=REC(PCE)
+4 WRITE REC
IF CACHE
WRITE !
KILL ACK
+5 ; TYPICALLY, WE GET SUB-SECOND RESPONSE TIME
READ ACK:60
+6 IF '$DATA(ACK)
SET STOP=0
QUIT
+7 IF $EXTRACT(ACK)=1
FOR
IF $EXTRACT(ACK,2)'=1
QUIT
SET ACK=$EXTRACT(ACK,2,99)
+8 IF ACK'=1
SET STOP=1
+9 QUIT
End DoDot:1
IF $DATA(STOP)
QUIT
LOOPFAIL ; PRINT SERVICE STARTS RECEPTION, BUT DATA TRANSMISSION FAILS. MANAGE THE ERROR.
IF $DATA(STOP)
Begin DoDot:1
+1 DO CTCP
+2 IF 'STOP
DO REG^VENPCCP2(1,"Print Service starts but then does not respond")
QUIT
+3 DO REG^VENPCCP2(1,"Print Service starts, but then it reports a data transmission failure")
+4 QUIT
End DoDot:1
QUIT 0
MERGE ; START MAIL MERGE
SET @TMP=(MSG_" Starting mail merge")
+1 ; SEND MESSAGE: "STOP" = ALL DATA SENT, START TO GENERATE THE MERGED DOCUMENT
WRITE "STOP"
IF CACHE
WRITE !
KILL ACK
+2 ; IF THINGS ARE WORKING NORMALLY, THE ACK SHOULD COME BACK WITHIN A FEW SECONDS
READ ACK:60
CLOSESVS ; CLOSE THE TCP CONNECTION
DO CTCP
SUCCESS IF $GET(ACK)=0
SET @TMP=(MSG_" Success!!!")
QUIT 1
RETRY ; PROBABLY A COM PROBLEM. TRY 2 TIMES ; PATCHED BY GIS/OIT 5/15/08 ; PCC+ 2.6 PATCH 1 ; WORK AROUND FOR COM ERROR
IF ACK=-1
SET ECNT=ECNT+1
IF ECNT<2
Begin DoDot:1
+1 SET @TMP=(MSG_" Retry #"_ECNT)
+2 ; IF POSSIBLE, TRY A DIFFERENT PRINT SERVER
IF $GET(IPA)'=""
IF IPA'=IP
SET IP=IPA
+3 HANG 1
+4 QUIT
End DoDot:1
GOTO TRY
MERGFAIL ; MERGE HAS FAILED. MANAGE THE ERROR.
DO MERGFAIL^VENPCCP2($GET(ACK),$GET(MRPFLAG),PGIEN)
+1 QUIT 0
+2 ;
VAR ; EP-GET MISC VARS REQUIRED FOR ERROR PROCESSING
+1 ; GET ENVIRONMENTAL VARS: VISIT, DUZ, DUZ(2), DFN, DUZ(0), VENDEV, DEFEF, MRPFLG
+2 IF '$GET(VER25)
DO VARS
QUIT
+3 NEW CNT,STG,X,Y,Z,%,VE,VD,VP
+4 SET (VE,VD,VP)=""
+5 SET (CNT,CKSUM,MAXPCE)=0
+6 FOR
SET CNT=$ORDER(REC(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+7 SET CKSUM=CKSUM+$LENGTH(REC(CNT))
+8 SET MAXPCE=CNT
+9 SET STG=REC(CNT)_$GET(REC(CNT+1))
+10 ; GET ENVIRONMENTAL VARIABLES
IF 'VE
FOR X="PRINTER","printer"
Begin DoDot:2
+11 SET Y="^"_X_$CHAR(30)
+12 IF STG'[Y
QUIT
+13 ; DATA STRING
SET %=$PIECE(STG,Y,2)
SET %=$PIECE(%,U)
+14 ; INCOMPLETE DATA STRING - WAIT FOR NEXT ITERATION
IF $LENGTH(%,";")'>5
QUIT
+15 SET VISIT=$PIECE(%,";")
SET DFN=$PIECE(%,";",4)
SET VENDEV=$PIECE(%,U,6)
SET VE=1
+16 SET %=$CHAR(68,85,90)
+17 SET @%=$PIECE(%,";",2)
SET @%@(2)=$PIECE(%,";",3)
SET @%@(0)=$PIECE(%,U,5)
+18 QUIT
End DoDot:2
+19 ; GET TEMPLATE
IF 'VD
FOR X="TEMPLATE","template"
Begin DoDot:2
+20 SET Y="^"_X_$CHAR(30)
+21 IF STG'[Y
QUIT
+22 ; DATA STRING
SET %=$PIECE(STG,Y,2)
+23 ; INCOMPLETE, WAIT FOR NEXT ITERATION
IF %'[U
QUIT
+24 SET %=$PIECE(%,U)
+25 SET DEFEF=""
SET VD=1
+26 IF '$LENGTH(%)
QUIT
+27 SET Z=0
+28 FOR
SET Z=$ORDER(^VEN(7.41,Z))
IF 'Z
QUIT
IF $PIECE($GET(^(Z,0)),U,3)=%
SET DEFEF=Z
QUIT
+29 QUIT
End DoDot:2
+30 ; GET PRINT GROUP
IF 'VP
FOR X="GROUP","group"
Begin DoDot:2
+31 SET Y="^"_X_$CHAR(30)
+32 IF STG'[Y
QUIT
+33 ; DATA STRING
SET %=$PIECE(STG,Y,2)
+34 ; INCOMPLETE, WAIT FOR NEXT ITERATION
IF %'[U
QUIT
+35 SET %=$PIECE(%,U)
+36 SET PGIEN=""
SET MRPFLAG=0
SET VP=1
+37 SET PGIEN=$ORDER(^VEN(7.4,"B",%,0))
IF 'PGIEN
QUIT
+38 IF $$MRP^VENPCCU=$P($GET(^VEN(7.4,PGIEN,0)),U)
SET MRPFLAG=1
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 QUIT
+42 ;
VARS ; EP-OLD WAY OF GETTING ENVIRONMENTAL VARS TO POPULATE ERROR MSG FILE
+1 NEW %,X,Z
FMVARS SET %=$PIECE(REC(1),U,4)
+1 SET Z=$CHAR(68,85,90)
+2 SET VISIT=$PIECE(%,";")
SET @Z=$PIECE(%,";",2)
SET @Z@(2)=$PIECE(%,";",3)
SET DFN=$PIECE(%,";",4)
SET @Z@(0)=$PIECE(%,U,5)
SET VENDEV=$PIECE(%,U,6)
DEFEF ; GET DEFAULT TEMPLTE IEN
SET %=$PIECE(REC(1),U,2)
SET DEFEF=""
SET Z=0
+1 FOR
SET Z=$ORDER(^VEN(7.41,Z))
IF 'Z
QUIT
IF $PIECE($GET(^(Z,0)),U,3)=%
SET DEFEF=Z
QUIT
PGIEN ; GET PRINT GROUP IEN
SET %=$PIECE(REC(1),U,3)
SET PGIEN=""
SET MRPFLAG=0
+1 ; IDENTIFY PRINT GROUP IEN
IF $LENGTH(%)
SET PGIEN=$ORDER(^VEN(7.4,"B",%,0))
MRPFLAG ; THIS DOCUMENT IS GOING TO THE MED REC PRINTER
IF $$MRP^VENPCCU=$P($GET(^VEN(7.4,+$GET(PGIEN),0)),U)
SET MRPFLAG=1
+1 QUIT
+2 ;
+3 ; -------------------------------------------------------------
+4 ;
+5 ; GENERIC PRINT DEAMON FUNCTIONS USED BY MANY ROUTINES
+6 ;
OPN(PATH,FILE,RW,EX) ; EP-CLEAN HFS OPEN, USE, EXECUTE, CLOSE
+1 NEW DEV,POP,TRY,F,CACHE
+2 SET F=PATH_FILE
SET POP=1
SET TRY=0
SET CACHE=($$VEN^VENPCCU=2)
OPN1 IF 'CACHE
XECUTE ("F DEV=51:1:54 O DEV:(F:RW):2 I $T S POP=0 U DEV X EX C DEV Q")
+1 IF CACHE
Begin DoDot:1
+2 SET RW=$SELECT(RW="W":"WNS",1:"RS")
SET DEV=F
+3 XECUTE ("O"_" F:(RW):2")
+4 XECUTE ("I S POP=0 "_"U"_" F X EX "_"C"_" F")
+5 QUIT
End DoDot:1
QUIT POP
+6 IF 'POP
QUIT 0
+7 ; STOP TRYING IF STOP OPTION HAS BEEN SELECTED
+8 IF '$DATA(^TMP("VEN TASK",$JOB))
QUIT 2
+9 SET TRY=TRY+1
IF TRY>5
QUIT 1
+10 HANG 2
GOTO OPN1
+11 ;
FIRST(PATH) ; EP-FIRST FILE IN THE PATH
+1 IF $$VEN^VENPCCU=2
XECUTE ("S RESULT=$"_"Z"_"SEARCH("""_PATH_"*.TXT"")")
QUIT $PIECE(RESULT,"\",$LENGTH(RESULT,"\"))
+2 IF $$OS^VENPCCU
SET RESULT=$$UNIX(PATH,"S RESULT="""" F R % Q:%="""" I %["".TXT""!(%["".txt"") S RESULT=% Q")
QUIT RESULT
+3 NEW X,PF
+4 SET PF=PATH_"*.TXT"
+5 DO FUNC("FIRST")
+6 QUIT $PIECE(X,U)
+7 ;
DEL(PATH,F) ; EP-FROM VENPCC2A - DELETE A FILE FROM THE PRINT QUEUE
+1 ; UNIX/CACHE
IF $$VEN^VENPCCU=2
IF $$OS^VENPCCU=1
XECUTE ("I $"_"Z"_"F(-1,""rm "_PATH_F_""")")
QUIT
+2 ; NT/CACHE
IF $$VEN^VENPCCU=2
XECUTE ("I $"_"Z"_"F(-1,""del "_PATH_F_""")")
QUIT
+3 ; UNIX/MSM
IF $$OS^VENPCCU
DO UCMD("rm "_PATH_F)
QUIT
+4 NEW PF,X,%
+5 SET PF=PATH_F
+6 ; NT/MSM
DO FUNC("DEL")
+7 QUIT
+8 ;
COUNT(PATH) ; EP-COUNT FILES WAITING TO BE PROCESSED
+1 NEW FILE,CNT
+2 IF $$VEN^VENPCCU=2
XECUTE ("F CNT=0:1 S FILE=$S('CNT:(PATH_""*.TXT""),1:"""") S FILE=$"_"Z"_"SEARCH(FILE) I '$L(FILE) Q")
QUIT CNT
+3 IF $$OS^VENPCCU
NEW RESULT,X
SET RESULT=$$UNIX(PATH,"S RESULT=0 F R X Q:'$L(X) I X["".TXT""!(X["".txt"") S RESULT=RESULT+1")
QUIT RESULT
+4 NEW PF,CNT
+5 SET PF=PATH_"*.TXT"
+6 DO FUNC("FIRST")
+7 IF '$LENGTH(X)
QUIT 0
+8 SET CNT=1
COUNT1 DO FUNC("NEXT")
+1 IF X=""
QUIT CNT
+2 SET CNT=CNT+1
+3 GOTO COUNT1
+4 ;
FIND(PATH,TARGET) ;EP-RETURN A '1' IF A FILE EXISTS
+1 NEW FILE
+2 IF $$VEN^VENPCCU=2
XECUTE ("S TARGET=$"_"Z"_"SEARCH(PATH_TARGET)")
QUIT ($LENGTH(TARGET)>0)
+3 IF $$OS^VENPCCU
NEW RESULT,X
SET RESULT=$$UNIX(PATH,"S RESULT=0 F R X Q:'$L(X) I $P(X,U)=TARGET S RESULT=1 Q")
QUIT RESULT
+4 NEW PF
+5 SET PF=PATH_TARGET
+6 DO FUNC("FIRST")
+7 IF '$LENGTH(X)
QUIT 0
+8 IF $PIECE(X,U)=TARGET
QUIT 1
FIND1 XECUTE "S X=$"_"Z"_"OS(13,X)"
+1 IF X=""
QUIT 0
+2 IF $PIECE(X,U)=TARGET
QUIT 1
+3 GOTO FIND1
+4 ;
UCMD(CMD) ;EP-UNIX COMMANDS
+1 IF '$LENGTH($GET(CMD))
QUIT
+2 XECUTE ("I $$JOB"_"WAIT"_U_"%HOST"_"CMD(CMD)")
+3 QUIT
+4 ;
UNIX(PATH,EX) ; EP-EXAMINE A UNIX DIRECTORY
+1 NEW PATH2,PATHX,FILE,CMD,RESULT
+2 SET PATH2=$GET(^VEN(7.5,CFIGIEN,3))
SET PATHX=$EXTRACT(PATH,1,$LENGTH(PATH)-1)
SET RESULT=""
+3 SET FILE="ven_"_+$JOB_".temp"
SET CMD="ls "_PATHX_" > "_PATH2_FILE
+4 DO UCMD(CMD)
+5 SET POP=$$OPN(PATH2,FILE,"R",EX)
IF POP
QUIT ""
+6 DO DEL(PATH2,FILE)
+7 QUIT RESULT
+8 ;
OTCP(IP,SOCKET) ; EP-OPEN TCP
+1 NEW IO,IOF,IOT,IOST,POP
+2 IF $$VEN^VENPCCU<2
DO CALL^%ZISTCP(IP,SOCKET,10)
QUIT POP
+3 SET POP=1
XECUTE ("O"_" ""|TCP|"_SOCKET_""":"""_IP_""":5")
IF $TEST
SET POP=0
XECUTE ("U"_" ""|TCP|"_SOCKET_"""")
+4 QUIT POP
+5 ;
CTCP ; EP-CLOSE TCP
+1 IF $$VEN^VENPCCU<2
XECUTE ("C"_" 56")
QUIT
+2 IF '$GET(SOCKET)
NEW SOCKET
SET SOCKET=$PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,11)),U,3)
+3 XECUTE ("C"_" ""|TCP|"_SOCKET_"""")
+4 QUIT
+5 ;
FUNC(ACT) ; EP-MSM/NT FUNCTIONS
+1 NEW %,Y
+2 SET %="S X=$"_"Z"_"O"
+3 IF ACT="FIRST"
XECUTE (%_"S(12,PF,0)")
QUIT
+4 IF ACT="NEXT"
XECUTE (%_"S(13,X)")
QUIT
+5 IF ACT="DEL"
IF PF'["*."
XECUTE (%_"S(2,PF)")
QUIT
+6 IF ACT'="DEL"
QUIT
+7 DO FUNC("FIRST")
IF X=""
QUIT
+8 IF X[".txt"!(X[".TXT")
SET Y=X
SET PF=PATH_$PIECE(X,U)
DO FUNC("DEL")
SET X=Y
+9 FOR
DO FUNC("NEXT")
IF X=""
QUIT
IF X[".txt"!(X[".TXT")
SET Y=X
SET PF=PATH_$PIECE(X,U)
DO FUNC("DEL")
SET X=Y
+10 QUIT
+11 ;
HOLD(FILE,PATH) ; EP-IF TRANSMISSION FAILS, PUT THE FILE SET AT THE BACK OF THE LINE
+1 NEW X,N,M,%,F,R,CMD,STG,%
+2 SET N=$EXTRACT(FILE,2,99)
+3 FOR M="e","g","h","E","G","H"
SET F=(M_N)
IF $$FIND(PATH,F)
Begin DoDot:1
+4 SET R="z"_$EXTRACT(F)_$EXTRACT(F,3,99)
SET STG=" "_PATH_F_" "_PATH_R
+5 IF $$VEN^VENPCCU=2
SET CMD="copy"_STG
XECUTE ("S %=$"_"Z"_"F(-1,CMD)")
DO DEL(PATH,F)
QUIT
+6 IF $$OS^VENPCCU
SET CMD="cp"_STG
DO UCMD(CMD)
DO DEL(PATH,F)
QUIT
+7 XECUTE ("S %=$"_"ZO"_"S(3,PATH_F,PATH_R)")
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
KT HANG 3
KILLTASK ; EP - DEFINITIVE WAY TO STOP ALL INSTANCES OF THE PRINT DEAMON
+1 NEW X
+2 SET X=0
+3 ; MAKE SURE ALL PRINT DEAMON PROCESSES ARE SHUT DOWN
FOR
SET X=$ORDER(^TMP("VEN TASK",X))
IF 'X
QUIT
Begin DoDot:1
+4 ; INDIRECT WAY TO STOP ANOTHER PROCESS ; MSM
KILL ^TMP("VEN TASK",X)
+5 ; DIRECTLY STOP ANOTHER PRINT DEAMON PROCESS; CACHE ONLY
IF $PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,0)),"^",5)=2
XECUTE ("S %=$Z"_"UTIL(4,X)")
QUIT
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
