ACRFPRNT ;IHS/OIRM/DSD/THL,AEF - PRINT AUTHORIZED REQUESTS; [ 05/07/2007 3:39 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,20,22**;NOV 05, 2001
;;ROUTINE WHICH QUEUES SIGNED DOCUMENTS TO BE PRINTED AUTOMATICALLY
EN ;EP;TO PRINT REQUEST IN PROCUREMENT OFFICE ONCE APPROVED
Q:$P(^ACRDOC(ACRDOCDA,0),U,4)=35
K ACRX,ACRJST,ACRNOT,ACRCNG,ACRRSN
N ACRSSNOK S ACRSSNOK=1 ;ACR*2.1*3.36
I $P(ACRDOC0,U,19),ACRREF=103 D
.S ACRREFXX=103
.S ACRREF=116
.;SHIFT REF CODE SO APPROVED BPA CALL IS PRINTED AS REQUISITION
S ACRPODA=$P(ACRDOC0,U,8)
I $P(^ACRPO(ACRPODA,0),U,8)="" S ACRPODA=1 ;FINANCE OFF MISSING ACR*2.1*22.10 IM24567
N X,ACRPO0,ACRPODT,ACRPOC,ACRTOC,ACRTROC
S (ACRPO0,X)=$G(^ACRPO(ACRPODA,0)) ;ACR*2.1*3.26
S ACRPODT=$G(^ACRPO(ACRPODA,"DT")) ;ACR*2.1*3.26
S ACRPOC=$P(ACRPODT,U,11)
S ACRTOC=$P(ACRPODT,U,12)
S ACRTROC=$P(ACRPODT,U,13)
S ZTIO2=$P(X,U,8)
S ZTIO7=$P(X,U,16)
S ZTIO8=$P(X,U,17)
S ZTIO9=$P(X,U,18)
S ZTIO2=$P(^AUTTPRG(ZTIO2,"DT"),U,10)
S ZTIO1=$P(ACRPO0,U,2)
S ZTIO5=$P(ACRPO0,U,14)
S ACRCOPY=$P(ACRPODT,U,6)
S:ZTIO7 ZTIO7=$P(^AUTTPRG(ZTIO7,"DT"),U,10)
S ZTIO6=$P(^ACRPO(1,0),U,15)
S ACRLBDA=$P(ACRDOC0,U,6)
S (ZTIO3,ZTIO4)=""
S X=$G(^ACRLOCB(+ACRLBDA,0))
S (ACRDPTDA,X)=$P(X,U,5)
S X=$G(^AUTTPRG(+X,"DT"))
S ZTIO3=$P(X,U,10)
;S ZTIO4=$P(X,U,12) ; REMOVE LINE ;ACR*2.1*3.26
;SEND REQUISITIONS AND PO'S TO PROCUREMENT
I "^116^204^103^349^326^210^"[(U_ACRREF_U) D
.Q:ACRPOC=0
.I ACRPOC,ACRPOC'[1 Q
.S ZTIO=ZTIO1
.D SEND
;SEND REQUISITIONS AND PO'S TO THE ORIGINATING DEPARTMENT IF PRINTER
;DIFFERENT FROM PROCUREMENT OFFICE PRINTER
I "^116^204^103^349^326^210^"[(U_ACRREF_U),ZTIO3'=ZTIO1 D
.Q:ACRPOC=0
.I ACRPOC,ACRPOC'[3 Q
.S ZTIO=ZTIO3
.D SEND
;SEND TRAVEL ORDER TO ORIGINATING DEPARTMENT
I ACRREF=130!(ACRREF=148) D
.I ACRREF=130,ACRTOC=0 Q
.I ACRREF=130,ACRTOC,ACRTOC'[3 Q
.I ACRREF=148,ACRTROC=0 Q
.I ACRREF=148,ACRTROC,ACRTROC'[3 Q
.S ZTIO=ZTIO3
.D SEND
;SEND TRAVEL ORDER TO CENTRAL PRINTER
I ACRREF=130,ZTIO5,ZTIO3'=ZTIO5 D
.Q:ACRTOC=0
.I ACRTOC,ACRTOC'[1 Q
.S ZTIO=ZTIO5
.D SEND
;SEND TRAVEL ORDER TO FINANCE IF FINANCE PRINTER DIFFERENT FROM
;DEPARTMENT OR CENTRAL PRINTER
I ACRREF=130!(ACRREF=148),ZTIO2'=$S(ACRREF=130&+ZTIO5:ZTIO5,1:ZTIO3) D
.I ACRREF=130,ACRTOC=0 Q
.I ACRREF=130,ACRTOC,ACRTOC'[2 Q
.I ACRREF=148,ACRTROC=0 Q
.I ACRREF=148,ACRTROC,ACRTROC'[2 Q
.S ZTIO=ZTIO2
.D SEND
;SEND TRAVEL ORDER TO REGIONAL FINANCE OFF IF REGIONAL FINANCE OFF
;PRINTER DIFFERENCT FROM FINANCE OFFICE, DEPARTMENT OR CENTRAL PRINTER
I ACRREF=130!(ACRREF=148),ZTIO7]"",ZTIO7'=ZTIO2,ZTIO7'=$S(ACRREF=130&+ZTIO5:ZTIO5,1:ZTIO3) D
.I ACRREF=130,ACRTOC=0 Q
.I ACRREF=130,ACRTOC,ACRTOC'[2 Q
.I ACRREF=148,ACRTROC=0 Q
.I ACRREF=148,ACRTROC,ACRTROC'[2 Q
.S ZTIO=ZTIO7
.D SEND
;SEND PURCHASE ORDER AND TRAVEL VOUCHER TO FINANCE
I "^103^349^326^210^600^"[(U_ACRREF_U)!(ACRREF=116&$P(^ACRDOC(ACRDOCDA,0),U,19)) D
.;Q:ACRPOC=0 ;ACR*2.1*20.01 IM15926
.I ACRREF'=600,ACRPOC=0 Q ;ACR*2.1*20.01 IM15926
.I "^103^349^326^210^"[(U_ACRREF_U),ACRPOC,ACRPOC'[2 Q
.S ZTIO=ZTIO2
.D SEND
;SEND REQUISITION TO FINANCE IF INDICATED FOR THE PURCHASING OFFICE
I ACRREF=116,$P(^ACRPO(ACRPODA,"DT"),U,9) D
.S ZTIO=ZTIO2
.D SEND
;SEND PURCHASE ORDER AND TRAVEL VOUCHER TO REGIONAL FINANCE OFFICE
I ZTIO7]"",ZTIO7'=ZTIO2,"^103^349^326^210^600^"[(U_ACRREF_U)!(ACRREF=116&$P(^ACRDOC(ACRDOCDA,0),U,19)) D
.S ZTIO=ZTIO7
.D SEND
;SEND THE TRAVEL VOUCHER TO DEPARTMENT
;IF PRINTER NOT SAME AS FINANCE PRINTER ;ACR*2.1*20.01 IM15926
I ACRREF=600 D
.S ZTIO=$S(+ZTIO4:ZTIO4,1:ZTIO3)
.I ZTIO2]"",ZTIO2=ZTIO Q ;ACR*2.1*20.01 IM15926
.D SEND
;SEND REQUISITIONS AND PO'S TO AREA PROPERTY IF PRINTER
;DIFFERENT FROM PROCUREMENT OFFICE PRINTER AND PROPERTY ITEMS PURCHASED
I "^116^204^103^349^326^210^"[(U_ACRREF_U),ZTIO6,ZTIO6'=ZTIO1 D
.S ZTIO=ZTIO6
.D PROP
;SEND REQUISITIONS AND PO'S TO AREA SUPPLY IF PRINTER
;DIFFERENT FROM PROCUREMENT OFFICE PRINTER AND SUPPLY ITEMS PURCHASED
I "^116^204^103^349^326^210^"[(U_ACRREF_U),ZTIO8,ZTIO8'=ZTIO1 D
.S ZTIO=ZTIO8
.D SUPP
.I $D(ACRQUIT) K ACRQUIT D SEND
;SEND TRAINING REQUEST TO AREA PERSONNEL PRINTER
;DIFFERENT FROM PROCUREMENT OFFICE PRINTER
I ACRREF=148,ZTIO9,ZTIO9'=ZTIO1 D
.I ACRREF=148,ACRTROC=0 Q
.I ACRREF=148,ACRTROC,ACRTROC'[1 Q
.S ZTIO=ZTIO9
.D SEND
K ZTIO,ZTIO1,ZTIO2,ZTIO3,ZTIO4,ZTIO5,ZTIO6,ZTIO7,ZTIO8,ZTIO9
I $D(ACRREFXX),$P(ACRDOC0,U,19),ACRREF=116 D
.S ACRREF=103
.K ACRREFXX
Q
SEND ;SELECT IO AND SEND TO TASKMAN
Q:'ZTIO
I "^103^349^326^210^130^600^148^"[(U_ACRREF_U) S ACRDHR=""
I ACRREF=130,ZTIO3'=ZTIO S ACRITINY=""
I $G(ACRAPVT)=9 S ACRTVAL=""
S ZTIO=$P($G(^%ZIS(1,+ZTIO,0)),U)
D TSK:ZTIO]""&(ZTIO'["HOST FILE")
Q
EN1 ;EP;TO PRINT REQUEST
S ACRLBDA=$P(ACROBL0,U,3)
S ZTIO=$P(^ACRLOCB(ACRLBDA,0),U,5)
S ZTIO=$G(^AUTTPRG(+ZTIO,"DT"))
S ZTIO=$P(ZTIO,U,10)
S ZTIO=$G(^%ZIS(1,+ZTIO,0))
S ZTIO=$P(ZTIO,U)
D:ZTIO]"" TSK
S ACRQUIT=""
Q
TSK ;QUEUE PRINT TASK
D FS^ACRFZIS
S ZTDTH=$H
S ACRREFX=ACRREF
S ACRREQST=""
S ZTSAVE("ACR*")=""
S ZIBH=$TR($H,",","")_$R(1000)
S ZTSAVE("ZIBH")=""
S:ACRREFX=103!(ACRREFX=349)!(ACRREFX=326) ACRPPO=""
D TSKVAR
D ^%ZTLOAD
K ZTIO,ZTSAVE,ZTDESC,ZTRTN,ZTDTH,ZIBH
Q
TSKVAR ;EP;SET REQUIRED PRINT JOB VARIABLES
S ZTRTN="OPEN^ACRFZIS"
S ACRRTN="^ACRFQ"
S ZTDESC="PRINT "_$S('$D(ACRPO):"APPROVED REQUEST",1:"PURCHASE ORDER")_" "_$S('$D(ACRPO):$P(ACRDOC0,U),ACRREFX=130!(ACRREFX=600):$P(ACRDOC0,U),1:$P(^ACRDOC(ACRDOCDA,0),U,2))
S ACRPRT=""
Q
PROP ;PRINT TO AREA PROPERTY
K ACRQUIT
D PROP^ACRFRRPT
I $D(ACRQUIT),ZTIO]"" D SEND
K ACRQUIT
Q
SUPP ;EP;TO PRINT REPORT TO SUPPLY OFFICE PRINTER
K ACRQUIT
N ACRSSDA
S ACRSSDA=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRQUIT) I $D(^ACRSS(ACRSSDA,0)) S ACROBJDA=$P(^(0),U,4) I ACROBJDA,$D(^AUTTOBJC(ACROBJDA,0)),$E(^(0),1,2)="26" S ACRQUIT="" Q
Q
ACRFPRNT ;IHS/OIRM/DSD/THL,AEF - PRINT AUTHORIZED REQUESTS; [ 05/07/2007 3:39 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,20,22**;NOV 05, 2001
+2 ;;ROUTINE WHICH QUEUES SIGNED DOCUMENTS TO BE PRINTED AUTOMATICALLY
EN ;EP;TO PRINT REQUEST IN PROCUREMENT OFFICE ONCE APPROVED
+1 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
QUIT
+2 KILL ACRX,ACRJST,ACRNOT,ACRCNG,ACRRSN
+3 ;ACR*2.1*3.36
NEW ACRSSNOK
SET ACRSSNOK=1
+4 IF $PIECE(ACRDOC0,U,19)
IF ACRREF=103
Begin DoDot:1
+5 SET ACRREFXX=103
+6 SET ACRREF=116
+7 ;SHIFT REF CODE SO APPROVED BPA CALL IS PRINTED AS REQUISITION
End DoDot:1
+8 SET ACRPODA=$PIECE(ACRDOC0,U,8)
+9 ;FINANCE OFF MISSING ACR*2.1*22.10 IM24567
IF $PIECE(^ACRPO(ACRPODA,0),U,8)=""
SET ACRPODA=1
+10 NEW X,ACRPO0,ACRPODT,ACRPOC,ACRTOC,ACRTROC
+11 ;ACR*2.1*3.26
SET (ACRPO0,X)=$GET(^ACRPO(ACRPODA,0))
+12 ;ACR*2.1*3.26
SET ACRPODT=$GET(^ACRPO(ACRPODA,"DT"))
+13 SET ACRPOC=$PIECE(ACRPODT,U,11)
+14 SET ACRTOC=$PIECE(ACRPODT,U,12)
+15 SET ACRTROC=$PIECE(ACRPODT,U,13)
+16 SET ZTIO2=$PIECE(X,U,8)
+17 SET ZTIO7=$PIECE(X,U,16)
+18 SET ZTIO8=$PIECE(X,U,17)
+19 SET ZTIO9=$PIECE(X,U,18)
+20 SET ZTIO2=$PIECE(^AUTTPRG(ZTIO2,"DT"),U,10)
+21 SET ZTIO1=$PIECE(ACRPO0,U,2)
+22 SET ZTIO5=$PIECE(ACRPO0,U,14)
+23 SET ACRCOPY=$PIECE(ACRPODT,U,6)
+24 IF ZTIO7
SET ZTIO7=$PIECE(^AUTTPRG(ZTIO7,"DT"),U,10)
+25 SET ZTIO6=$PIECE(^ACRPO(1,0),U,15)
+26 SET ACRLBDA=$PIECE(ACRDOC0,U,6)
+27 SET (ZTIO3,ZTIO4)=""
+28 SET X=$GET(^ACRLOCB(+ACRLBDA,0))
+29 SET (ACRDPTDA,X)=$PIECE(X,U,5)
+30 SET X=$GET(^AUTTPRG(+X,"DT"))
+31 SET ZTIO3=$PIECE(X,U,10)
+32 ;S ZTIO4=$P(X,U,12) ; REMOVE LINE ;ACR*2.1*3.26
+33 ;SEND REQUISITIONS AND PO'S TO PROCUREMENT
+34 IF "^116^204^103^349^326^210^"[(U_ACRREF_U)
Begin DoDot:1
+35 IF ACRPOC=0
QUIT
+36 IF ACRPOC
IF ACRPOC'[1
QUIT
+37 SET ZTIO=ZTIO1
+38 DO SEND
End DoDot:1
+39 ;SEND REQUISITIONS AND PO'S TO THE ORIGINATING DEPARTMENT IF PRINTER
+40 ;DIFFERENT FROM PROCUREMENT OFFICE PRINTER
+41 IF "^116^204^103^349^326^210^"[(U_ACRREF_U)
IF ZTIO3'=ZTIO1
Begin DoDot:1
+42 IF ACRPOC=0
QUIT
+43 IF ACRPOC
IF ACRPOC'[3
QUIT
+44 SET ZTIO=ZTIO3
+45 DO SEND
End DoDot:1
+46 ;SEND TRAVEL ORDER TO ORIGINATING DEPARTMENT
+47 IF ACRREF=130!(ACRREF=148)
Begin DoDot:1
+48 IF ACRREF=130
IF ACRTOC=0
QUIT
+49 IF ACRREF=130
IF ACRTOC
IF ACRTOC'[3
QUIT
+50 IF ACRREF=148
IF ACRTROC=0
QUIT
+51 IF ACRREF=148
IF ACRTROC
IF ACRTROC'[3
QUIT
+52 SET ZTIO=ZTIO3
+53 DO SEND
End DoDot:1
+54 ;SEND TRAVEL ORDER TO CENTRAL PRINTER
+55 IF ACRREF=130
IF ZTIO5
IF ZTIO3'=ZTIO5
Begin DoDot:1
+56 IF ACRTOC=0
QUIT
+57 IF ACRTOC
IF ACRTOC'[1
QUIT
+58 SET ZTIO=ZTIO5
+59 DO SEND
End DoDot:1
+60 ;SEND TRAVEL ORDER TO FINANCE IF FINANCE PRINTER DIFFERENT FROM
+61 ;DEPARTMENT OR CENTRAL PRINTER
+62 IF ACRREF=130!(ACRREF=148)
IF ZTIO2'=$SELECT(ACRREF=130&+ZTIO5:ZTIO5,1:ZTIO3)
Begin DoDot:1
+63 IF ACRREF=130
IF ACRTOC=0
QUIT
+64 IF ACRREF=130
IF ACRTOC
IF ACRTOC'[2
QUIT
+65 IF ACRREF=148
IF ACRTROC=0
QUIT
+66 IF ACRREF=148
IF ACRTROC
IF ACRTROC'[2
QUIT
+67 SET ZTIO=ZTIO2
+68 DO SEND
End DoDot:1
+69 ;SEND TRAVEL ORDER TO REGIONAL FINANCE OFF IF REGIONAL FINANCE OFF
+70 ;PRINTER DIFFERENCT FROM FINANCE OFFICE, DEPARTMENT OR CENTRAL PRINTER
+71 IF ACRREF=130!(ACRREF=148)
IF ZTIO7]""
IF ZTIO7'=ZTIO2
IF ZTIO7'=$SELECT(ACRREF=130&+ZTIO5:ZTIO5,1:ZTIO3)
Begin DoDot:1
+72 IF ACRREF=130
IF ACRTOC=0
QUIT
+73 IF ACRREF=130
IF ACRTOC
IF ACRTOC'[2
QUIT
+74 IF ACRREF=148
IF ACRTROC=0
QUIT
+75 IF ACRREF=148
IF ACRTROC
IF ACRTROC'[2
QUIT
+76 SET ZTIO=ZTIO7
+77 DO SEND
End DoDot:1
+78 ;SEND PURCHASE ORDER AND TRAVEL VOUCHER TO FINANCE
+79 IF "^103^349^326^210^600^"[(U_ACRREF_U)!(ACRREF=116&$PIECE(^ACRDOC(ACRDOCDA,0),U,19))
Begin DoDot:1
+80 ;Q:ACRPOC=0 ;ACR*2.1*20.01 IM15926
+81 ;ACR*2.1*20.01 IM15926
IF ACRREF'=600
IF ACRPOC=0
QUIT
+82 IF "^103^349^326^210^"[(U_ACRREF_U)
IF ACRPOC
IF ACRPOC'[2
QUIT
+83 SET ZTIO=ZTIO2
+84 DO SEND
End DoDot:1
+85 ;SEND REQUISITION TO FINANCE IF INDICATED FOR THE PURCHASING OFFICE
+86 IF ACRREF=116
IF $PIECE(^ACRPO(ACRPODA,"DT"),U,9)
Begin DoDot:1
+87 SET ZTIO=ZTIO2
+88 DO SEND
End DoDot:1
+89 ;SEND PURCHASE ORDER AND TRAVEL VOUCHER TO REGIONAL FINANCE OFFICE
+90 IF ZTIO7]""
IF ZTIO7'=ZTIO2
IF "^103^349^326^210^600^"[(U_ACRREF_U)!(ACRREF=116&$PIECE(^ACRDOC(ACRDOCDA,0),U,19))
Begin DoDot:1
+91 SET ZTIO=ZTIO7
+92 DO SEND
End DoDot:1
+93 ;SEND THE TRAVEL VOUCHER TO DEPARTMENT
+94 ;IF PRINTER NOT SAME AS FINANCE PRINTER ;ACR*2.1*20.01 IM15926
+95 IF ACRREF=600
Begin DoDot:1
+96 SET ZTIO=$SELECT(+ZTIO4:ZTIO4,1:ZTIO3)
+97 ;ACR*2.1*20.01 IM15926
IF ZTIO2]""
IF ZTIO2=ZTIO
QUIT
+98 DO SEND
End DoDot:1
+99 ;SEND REQUISITIONS AND PO'S TO AREA PROPERTY IF PRINTER
+100 ;DIFFERENT FROM PROCUREMENT OFFICE PRINTER AND PROPERTY ITEMS PURCHASED
+101 IF "^116^204^103^349^326^210^"[(U_ACRREF_U)
IF ZTIO6
IF ZTIO6'=ZTIO1
Begin DoDot:1
+102 SET ZTIO=ZTIO6
+103 DO PROP
End DoDot:1
+104 ;SEND REQUISITIONS AND PO'S TO AREA SUPPLY IF PRINTER
+105 ;DIFFERENT FROM PROCUREMENT OFFICE PRINTER AND SUPPLY ITEMS PURCHASED
+106 IF "^116^204^103^349^326^210^"[(U_ACRREF_U)
IF ZTIO8
IF ZTIO8'=ZTIO1
Begin DoDot:1
+107 SET ZTIO=ZTIO8
+108 DO SUPP
+109 IF $DATA(ACRQUIT)
KILL ACRQUIT
DO SEND
End DoDot:1
+110 ;SEND TRAINING REQUEST TO AREA PERSONNEL PRINTER
+111 ;DIFFERENT FROM PROCUREMENT OFFICE PRINTER
+112 IF ACRREF=148
IF ZTIO9
IF ZTIO9'=ZTIO1
Begin DoDot:1
+113 IF ACRREF=148
IF ACRTROC=0
QUIT
+114 IF ACRREF=148
IF ACRTROC
IF ACRTROC'[1
QUIT
+115 SET ZTIO=ZTIO9
+116 DO SEND
End DoDot:1
+117 KILL ZTIO,ZTIO1,ZTIO2,ZTIO3,ZTIO4,ZTIO5,ZTIO6,ZTIO7,ZTIO8,ZTIO9
+118 IF $DATA(ACRREFXX)
IF $PIECE(ACRDOC0,U,19)
IF ACRREF=116
Begin DoDot:1
+119 SET ACRREF=103
+120 KILL ACRREFXX
End DoDot:1
+121 QUIT
SEND ;SELECT IO AND SEND TO TASKMAN
+1 IF 'ZTIO
QUIT
+2 IF "^103^349^326^210^130^600^148^"[(U_ACRREF_U)
SET ACRDHR=""
+3 IF ACRREF=130
IF ZTIO3'=ZTIO
SET ACRITINY=""
+4 IF $GET(ACRAPVT)=9
SET ACRTVAL=""
+5 SET ZTIO=$PIECE($GET(^%ZIS(1,+ZTIO,0)),U)
+6 IF ZTIO]""&(ZTIO'["HOST FILE")
DO TSK
+7 QUIT
EN1 ;EP;TO PRINT REQUEST
+1 SET ACRLBDA=$PIECE(ACROBL0,U,3)
+2 SET ZTIO=$PIECE(^ACRLOCB(ACRLBDA,0),U,5)
+3 SET ZTIO=$GET(^AUTTPRG(+ZTIO,"DT"))
+4 SET ZTIO=$PIECE(ZTIO,U,10)
+5 SET ZTIO=$GET(^%ZIS(1,+ZTIO,0))
+6 SET ZTIO=$PIECE(ZTIO,U)
+7 IF ZTIO]""
DO TSK
+8 SET ACRQUIT=""
+9 QUIT
TSK ;QUEUE PRINT TASK
+1 DO FS^ACRFZIS
+2 SET ZTDTH=$HOROLOG
+3 SET ACRREFX=ACRREF
+4 SET ACRREQST=""
+5 SET ZTSAVE("ACR*")=""
+6 SET ZIBH=$TRANSLATE($HOROLOG,",","")_$RANDOM(1000)
+7 SET ZTSAVE("ZIBH")=""
+8 IF ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
SET ACRPPO=""
+9 DO TSKVAR
+10 DO ^%ZTLOAD
+11 KILL ZTIO,ZTSAVE,ZTDESC,ZTRTN,ZTDTH,ZIBH
+12 QUIT
TSKVAR ;EP;SET REQUIRED PRINT JOB VARIABLES
+1 SET ZTRTN="OPEN^ACRFZIS"
+2 SET ACRRTN="^ACRFQ"
+3 SET ZTDESC="PRINT "_$SELECT('$DATA(ACRPO):"APPROVED REQUEST",1:"PURCHASE ORDER")_" "_$SELECT('$DATA(ACRPO):$PIECE(ACRDOC0,U),ACRREFX=130!(ACRREFX=600):$PIECE(ACRDOC0,U),1:$PIECE(^ACRDOC(ACRDOCDA,0),U,2))
+4 SET ACRPRT=""
+5 QUIT
PROP ;PRINT TO AREA PROPERTY
+1 KILL ACRQUIT
+2 DO PROP^ACRFRRPT
+3 IF $DATA(ACRQUIT)
IF ZTIO]""
DO SEND
+4 KILL ACRQUIT
+5 QUIT
SUPP ;EP;TO PRINT REPORT TO SUPPLY OFFICE PRINTER
+1 KILL ACRQUIT
+2 NEW ACRSSDA
+3 SET ACRSSDA=0
+4 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA!$DATA(ACRQUIT)
QUIT
IF $DATA(^ACRSS(ACRSSDA,0))
SET ACROBJDA=$PIECE(^(0),U,4)
IF ACROBJDA
IF $DATA(^AUTTOBJC(ACROBJDA,0))
IF $EXTRACT(^(0),1,2)="26"
SET ACRQUIT=""
QUIT
+5 QUIT
