source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSMCL.m@ 1150

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1PRCPSMCL ;WISC/RFJ-create and transmit log code sheet from tmp ;22 Mar 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7TRANSMIT(V1,V2,V3) ;transmit code sheets from tmp global
8 ; v1=station number
9 ; v2=transaction type
10 ; v3=1stQueue^2ndQueue^... (form LOG)
11 ; tmp($j,"string",1:n)=code sheet data
12 ; returns prcpxmz(sequence number)=mailman message number
13 ;
14 N %,COUNT,CSHEET,DATA,LINE,PRCPSITE,SEQUENCE,XMZ
15 ;
16 K ^TMP($J,"PRCPSMC0"),PRCPXMZ S PRCPSITE=+V1
17 ;
18 ; move code sheets to message number in tmp global
19 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
20 . ;
21 . ; build message in tmp
22 . S ^TMP($J,"PRCPSMC0",SEQUENCE,LINE,0)=DATA,LINE=LINE+1
23 . ;
24 . ; increment counters if line equals 100 (code sheets)
25 . I $O(^TMP($J,"STRING",CSHEET)),LINE=100 S SEQUENCE=SEQUENCE+1,LINE=1
26 ;
27 ; transmit
28 F COUNT=1:1:SEQUENCE Q:'$D(^TMP($J,"PRCPSMC0",COUNT)) D
29 . ;
30 . ; create and transmit mail message
31 . D MAILMSG^PRCPSMCS(COUNT,SEQUENCE,V2,V3)
32 . S PRCPXMZ(COUNT)=+$G(XMZ)
33 . ;I $G(XMZ) S %=$O(^PRC(411,PRCPSITE,2,"AC","S","")) I %'="" D PRINT(XMZ,%)
34 K ^TMP($J,"PRCPSMC0")
35 Q
36 ;
37 ;
38PRINT(V1,V2) ; forward mailman message to printer devive
39 ; v1=mailman message number
40 ; v2=printer device ^ printer device ^ ...
41 N C,DIC,ER,X,XMDT,XMDUZ,XMY,XMZ,ZTPAR
42 S XMZ=+V1,XMDUZ=DUZ
43 F %=1:1 Q:$P(V2,"^",%)="" S XMY("D."_$P(V2,"^",%)_"@"_$G(^XMB("NETNAME")))=""
44 D ENT1^XMD Q
Note: See TracBrowser for help on using the repository browser.