PRCPSMCL ;WISC/RFJ-create and transmit log code sheet from tmp ;22 Mar 93
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
TRANSMIT(V1,V2,V3) ;transmit code sheets from tmp global
; v1=station number
; v2=transaction type
; v3=1stQueue^2ndQueue^... (form LOG)
; tmp($j,"string",1:n)=code sheet data
; returns prcpxmz(sequence number)=mailman message number
;
N %,COUNT,CSHEET,DATA,LINE,PRCPSITE,SEQUENCE,XMZ
;
K ^TMP($J,"PRCPSMC0"),PRCPXMZ S PRCPSITE=+V1
;
; move code sheets to message number in tmp global
S SEQUENCE=1,LINE=1,(COUNT,CSHEET)=0 F S CSHEET=$O(^TMP($J,"STRING",CSHEET)) Q:'CSHEET S DATA=^(CSHEET),COUNT=COUNT+1 D
. ;
. ; build message in tmp
. S ^TMP($J,"PRCPSMC0",SEQUENCE,LINE,0)=DATA,LINE=LINE+1
. ;
. ; increment counters if line equals 100 (code sheets)
. I $O(^TMP($J,"STRING",CSHEET)),LINE=100 S SEQUENCE=SEQUENCE+1,LINE=1
;
; transmit
F COUNT=1:1:SEQUENCE Q:'$D(^TMP($J,"PRCPSMC0",COUNT)) D
. ;
. ; create and transmit mail message
. D MAILMSG^PRCPSMCS(COUNT,SEQUENCE,V2,V3)
. S PRCPXMZ(COUNT)=+$G(XMZ)
. ;I $G(XMZ) S %=$O(^PRC(411,PRCPSITE,2,"AC","S","")) I %'="" D PRINT(XMZ,%)
K ^TMP($J,"PRCPSMC0")
Q
;
;
PRINT(V1,V2) ; forward mailman message to printer devive
; v1=mailman message number
; v2=printer device ^ printer device ^ ...
N C,DIC,ER,X,XMDT,XMDUZ,XMY,XMZ,ZTPAR
S XMZ=+V1,XMDUZ=DUZ
F %=1:1 Q:$P(V2,"^",%)="" S XMY("D."_$P(V2,"^",%)_"@"_$G(^XMB("NETNAME")))=""
D ENT1^XMD Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPSMCL 1587 printed Oct 16, 2024@18:16:37 Page 2
PRCPSMCL ;WISC/RFJ-create and transmit log code sheet from tmp ;22 Mar 93
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
TRANSMIT(V1,V2,V3) ;transmit code sheets from tmp global
+1 ; v1=station number
+2 ; v2=transaction type
+3 ; v3=1stQueue^2ndQueue^... (form LOG)
+4 ; tmp($j,"string",1:n)=code sheet data
+5 ; returns prcpxmz(sequence number)=mailman message number
+6 ;
+7 NEW %,COUNT,CSHEET,DATA,LINE,PRCPSITE,SEQUENCE,XMZ
+8 ;
+9 KILL ^TMP($JOB,"PRCPSMC0"),PRCPXMZ
SET PRCPSITE=+V1
+10 ;
+11 ; move code sheets to message number in tmp global
+12 SET SEQUENCE=1
SET LINE=1
SET (COUNT,CSHEET)=0
FOR
SET CSHEET=$ORDER(^TMP($JOB,"STRING",CSHEET))
if 'CSHEET
QUIT
SET DATA=^(CSHEET)
SET COUNT=COUNT+1
Begin DoDot:1
+13 ;
+14 ; build message in tmp
+15 SET ^TMP($JOB,"PRCPSMC0",SEQUENCE,LINE,0)=DATA
SET LINE=LINE+1
+16 ;
+17 ; increment counters if line equals 100 (code sheets)
+18 IF $ORDER(^TMP($JOB,"STRING",CSHEET))
IF LINE=100
SET SEQUENCE=SEQUENCE+1
SET LINE=1
End DoDot:1
+19 ;
+20 ; transmit
+21 FOR COUNT=1:1:SEQUENCE
if '$DATA(^TMP($JOB,"PRCPSMC0",COUNT))
QUIT
Begin DoDot:1
+22 ;
+23 ; create and transmit mail message
+24 DO MAILMSG^PRCPSMCS(COUNT,SEQUENCE,V2,V3)
+25 SET PRCPXMZ(COUNT)=+$GET(XMZ)
+26 ;I $G(XMZ) S %=$O(^PRC(411,PRCPSITE,2,"AC","S","")) I %'="" D PRINT(XMZ,%)
End DoDot:1
+27 KILL ^TMP($JOB,"PRCPSMC0")
+28 QUIT
+29 ;
+30 ;
PRINT(V1,V2) ; forward mailman message to printer devive
+1 ; v1=mailman message number
+2 ; v2=printer device ^ printer device ^ ...
+3 NEW C,DIC,ER,X,XMDT,XMDUZ,XMY,XMZ,ZTPAR
+4 SET XMZ=+V1
SET XMDUZ=DUZ
+5 FOR %=1:1
if $PIECE(V2,"^",%)=""
QUIT
SET XMY("D."_$PIECE(V2,"^",%)_"@"_$GET(^XMB("NETNAME")))=""
+6 DO ENT1^XMD
QUIT
