ACRFQ ;IHS/OIRM/DSD/THL,AEF - ROUTINE TO PRINT SELECTED DOCUMENTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO PRINT SELECTED DOCUMENTS
EN S:'$D(ACRCOPY) ACRCOPY=1
S:ACRCOPY<1 ACRCOPY=1
S:$E(IOST,1,2)="C-" ACRCOPY=1
S:ACRCOPY>6 ACRCOPY=6
F ACRIII=1:1:ACRCOPY D EN1
EXIT K ACRII,ACRCOPY,ACRCOST
I $D(ZTSK)#2,ZTSK,$D(^%ZTSK(ZTSK)) D STAT^%ZTLOAD I $D(ZTSK(1)),ZTSK(1)=3 D KILL^%ZTLOAD
Q
EN1 K ACRQUIT,ACROUT
W " "
S (ACRDOCDA,D0)=ACRDOCDA
D SETDOC^ACRFEA1
N DXS,DIP,DC,DN
S:'$D(ACRREFX) ACRREFX=ACRREF
I $P($G(^ACRDOC(ACRDOCDA,0)),U,4)=35 N ACRREF,ACRREFX,ACRREQST S (ACRREF,ACRREFX)=116,ACRREQST=""
I '$D(ACRRR)#2,$D(^ACRDOC(ACRDOCDA,3)),$P(^(3),U,13) N ACRREFX,ACRPO S ACRREFX=210
I ACRREFX=116&$D(ACRREQST)&$D(ACRPSUM) D ^ACRPRQS Q
I ACRREFX=116&$D(ACRREQST) D ^ACRPRQT D EN2 D Q
.S:'$D(D0) D0=ACRDOCDA
.I '$D(ACROUT),$D(ACREQUIP) S D0=ACRDOCDA D ^ACRPEC N ACREQUIP,DXS,DIP,DC,DN W:$Y>1 @IOF Q
.I '$D(ACROUT),$P(^ACRDOC(ACRDOCDA,0),U,18)>0 S D0=ACRDOCDA N DXS,DIP,DC,DN D ^ACRPBPA W:$Y>1 @IOF Q
I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)!$D(ACRPO) D D EN2 Q
.I '$P(^ACRDOC(ACRDOCDA,0),U,15) D
..I ACRREFX=326,'$D(ACRPSC) S ACRPSC=326
..I '$D(ACRPSC) D ^ACRPSS Q
..S ACRPX="^ACRF"_$P(ACRPSC,U)
..I +ACRPSC=326 S ACRPX="^ACRNP1"
..D @ACRPX
.D ^ACRPPOA:$P(^ACRDOC(ACRDOCDA,0),U,15)
.W:$Y>1 @IOF
.I $E(IOST,1,2)="P-",'$P(^ACRDOC(ACRDOCDA,0),U,15),$P(^ACRSYS(1,"DT"),U,23) S D0=1 D ^ACRPTC W @IOF
.I '$D(ACROUT),$P(^ACRDOC(ACRDOCDA,0),U,18)>0 S D0=ACRDOCDA N DXS,DIP,DC,DN D ^ACRPBPA W:$Y>1 @IOF Q
I ACRREFX=130!(ACRREFX=600),ACRREF=130!(ACRREF=600) D ^ACRFTOT
I ACRREFX=130&$D(ACRREQST)&$D(ACRPSUM) D ^ACRPTOS Q
I ACRREFX=130&$D(ACRTVI)&$D(ACRREQST) D ^ACRPSTI D EN2 Q
I ACRREFX=130&$D(ACRREQST) D ^ACRPTO D EN2 Q
I ACRREFX=499 D ^ACRRR D EN2 Q
I ACRREFX=210 D Q
.I '$P($G(^ACRDOC(ACRDOCDA,3)),U,17) D ^ACRFFS I 1
.E D ^ACRF3542
.D EN2
I ACRREFX=148 D ^ACRPTRG D EN2 Q
I ACRREFX=600&$D(ACRPSUM) D ^ACRPTVS Q
I ACRREFX=600 D ^ACRPTV D EN2 Q
I ACRREFX=999 D ^ACRFPRS D EN2 Q
I '$D(ACRREV) D ^ACRFPCRT D EN2 Q
Q
EN2 N DXS,DIP,DC,DN
I '$D(ACROUT),ACRREFX=116,$D(^ACROBL(ACRDOCDA,1,1,0)) S D0=ACRDOCDA N DXS,DIP,DC,DN D ^ACRPAR D PAUSE^ACRFWARN W:$Y>1 @IOF
I '$D(ACROUT),ACRREFX=148,$D(ACRTVAL) W @IOF S D0=ACRDOCDA N DXS,DIP,DC,DN W @IOF D ^ACRPTE D PAUSE^ACRFWARN W:$Y>1 @IOF K ACRTVAL
I $D(ACRCOST),'$D(ACROUT),"^103^349^326^116^204^210^"[(U_ACRREFX_U) D EN^ACRFPCC
I $D(ACRDHR) W:$Y>1 @IOF D PRINT^ACRFDHR
I $D(ACRSHIP),$D(^ACRSI("B",ACRDOCDA)) D DISPLAY^ACRFSHIP K ACRSHIP
W:$Y>1 @IOF
K DC,ACRPOTC,ACRDHR
Q
REQ ;EP;TO SETUP TO PRINT REQUEST
S ACRRTN="^ACRFQ",ZTDESC="PRINT ARMS REQUEST"_$S($D(ACRDOC):", DOCUMENT # "_ACRDOC,1:"")
D ^ACRFZIS
Q
ACRFQ ;IHS/OIRM/DSD/THL,AEF - ROUTINE TO PRINT SELECTED DOCUMENTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO PRINT SELECTED DOCUMENTS
EN IF '$DATA(ACRCOPY)
SET ACRCOPY=1
+1 IF ACRCOPY<1
SET ACRCOPY=1
+2 IF $EXTRACT(IOST,1,2)="C-"
SET ACRCOPY=1
+3 IF ACRCOPY>6
SET ACRCOPY=6
+4 FOR ACRIII=1:1:ACRCOPY
DO EN1
EXIT KILL ACRII,ACRCOPY,ACRCOST
+1 IF $DATA(ZTSK)#2
IF ZTSK
IF $DATA(^%ZTSK(ZTSK))
DO STAT^%ZTLOAD
IF $DATA(ZTSK(1))
IF ZTSK(1)=3
DO KILL^%ZTLOAD
+2 QUIT
EN1 KILL ACRQUIT,ACROUT
+1 WRITE " "
+2 SET (ACRDOCDA,D0)=ACRDOCDA
+3 DO SETDOC^ACRFEA1
+4 NEW DXS,DIP,DC,DN
+5 IF '$DATA(ACRREFX)
SET ACRREFX=ACRREF
+6 IF $PIECE($GET(^ACRDOC(ACRDOCDA,0)),U,4)=35
NEW ACRREF,ACRREFX,ACRREQST
SET (ACRREF,ACRREFX)=116
SET ACRREQST=""
+7 IF '$DATA(ACRRR)#2
IF $DATA(^ACRDOC(ACRDOCDA,3))
IF $PIECE(^(3),U,13)
NEW ACRREFX,ACRPO
SET ACRREFX=210
+8 IF ACRREFX=116&$DATA(ACRREQST)&$DATA(ACRPSUM)
DO ^ACRPRQS
QUIT
+9 IF ACRREFX=116&$DATA(ACRREQST)
DO ^ACRPRQT
DO EN2
Begin DoDot:1
+10 IF '$DATA(D0)
SET D0=ACRDOCDA
+11 IF '$DATA(ACROUT)
IF $DATA(ACREQUIP)
SET D0=ACRDOCDA
DO ^ACRPEC
NEW ACREQUIP,DXS,DIP,DC,DN
IF $Y>1
WRITE @IOF
QUIT
+12 IF '$DATA(ACROUT)
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,18)>0
SET D0=ACRDOCDA
NEW DXS,DIP,DC,DN
DO ^ACRPBPA
IF $Y>1
WRITE @IOF
QUIT
End DoDot:1
QUIT
+13 IF ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)!$DATA(ACRPO)
Begin DoDot:1
+14 IF '$PIECE(^ACRDOC(ACRDOCDA,0),U,15)
Begin DoDot:2
+15 IF ACRREFX=326
IF '$DATA(ACRPSC)
SET ACRPSC=326
+16 IF '$DATA(ACRPSC)
DO ^ACRPSS
QUIT
+17 SET ACRPX="^ACRF"_$PIECE(ACRPSC,U)
+18 IF +ACRPSC=326
SET ACRPX="^ACRNP1"
+19 DO @ACRPX
End DoDot:2
+20 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,15)
DO ^ACRPPOA
+21 IF $Y>1
WRITE @IOF
+22 IF $EXTRACT(IOST,1,2)="P-"
IF '$PIECE(^ACRDOC(ACRDOCDA,0),U,15)
IF $PIECE(^ACRSYS(1,"DT"),U,23)
SET D0=1
DO ^ACRPTC
WRITE @IOF
+23 IF '$DATA(ACROUT)
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,18)>0
SET D0=ACRDOCDA
NEW DXS,DIP,DC,DN
DO ^ACRPBPA
IF $Y>1
WRITE @IOF
QUIT
End DoDot:1
DO EN2
QUIT
+24 IF ACRREFX=130!(ACRREFX=600)
IF ACRREF=130!(ACRREF=600)
DO ^ACRFTOT
+25 IF ACRREFX=130&$DATA(ACRREQST)&$DATA(ACRPSUM)
DO ^ACRPTOS
QUIT
+26 IF ACRREFX=130&$DATA(ACRTVI)&$DATA(ACRREQST)
DO ^ACRPSTI
DO EN2
QUIT
+27 IF ACRREFX=130&$DATA(ACRREQST)
DO ^ACRPTO
DO EN2
QUIT
+28 IF ACRREFX=499
DO ^ACRRR
DO EN2
QUIT
+29 IF ACRREFX=210
Begin DoDot:1
+30 IF '$PIECE($GET(^ACRDOC(ACRDOCDA,3)),U,17)
DO ^ACRFFS
IF 1
+31 IF '$TEST
DO ^ACRF3542
+32 DO EN2
End DoDot:1
QUIT
+33 IF ACRREFX=148
DO ^ACRPTRG
DO EN2
QUIT
+34 IF ACRREFX=600&$DATA(ACRPSUM)
DO ^ACRPTVS
QUIT
+35 IF ACRREFX=600
DO ^ACRPTV
DO EN2
QUIT
+36 IF ACRREFX=999
DO ^ACRFPRS
DO EN2
QUIT
+37 IF '$DATA(ACRREV)
DO ^ACRFPCRT
DO EN2
QUIT
+38 QUIT
EN2 NEW DXS,DIP,DC,DN
+1 IF '$DATA(ACROUT)
IF ACRREFX=116
IF $DATA(^ACROBL(ACRDOCDA,1,1,0))
SET D0=ACRDOCDA
NEW DXS,DIP,DC,DN
DO ^ACRPAR
DO PAUSE^ACRFWARN
IF $Y>1
WRITE @IOF
+2 IF '$DATA(ACROUT)
IF ACRREFX=148
IF $DATA(ACRTVAL)
WRITE @IOF
SET D0=ACRDOCDA
NEW DXS,DIP,DC,DN
WRITE @IOF
DO ^ACRPTE
DO PAUSE^ACRFWARN
IF $Y>1
WRITE @IOF
KILL ACRTVAL
+3 IF $DATA(ACRCOST)
IF '$DATA(ACROUT)
IF "^103^349^326^116^204^210^"[(U_ACRREFX_U)
DO EN^ACRFPCC
+4 IF $DATA(ACRDHR)
IF $Y>1
WRITE @IOF
DO PRINT^ACRFDHR
+5 IF $DATA(ACRSHIP)
IF $DATA(^ACRSI("B",ACRDOCDA))
DO DISPLAY^ACRFSHIP
KILL ACRSHIP
+6 IF $Y>1
WRITE @IOF
+7 KILL DC,ACRPOTC,ACRDHR
+8 QUIT
REQ ;EP;TO SETUP TO PRINT REQUEST
+1 SET ACRRTN="^ACRFQ"
SET ZTDESC="PRINT ARMS REQUEST"_$SELECT($DATA(ACRDOC):", DOCUMENT # "_ACRDOC,1:"")
+2 DO ^ACRFZIS
+3 QUIT
