- 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
