ACRFPALL ;IHS/OIRM/DSD/THL,AEF - PRINT SELECTED DOCUMENTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO PRINT SELECTED DOCUMENTS;
EN D EN1
EXIT K ACR,ACRPRTX
Q
EN1 S DIR(0)="LOA^1:99999"
S DIR("A")="Enter ID number(s): "
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
EN2 ;EP;TO PRINT MULTIPLE DOCUMENTS
S ACRPAL=ACRY
S ACRPALX=""
F ACRPAL1=1:1 S ACRPAL2=$P(ACRPAL,",",ACRPAL1) Q:'ACRPAL2 I $D(ACRPRTX(ACRPAL2)) S ACRPALX=ACRPALX_(ACRPAL2)_","
S ACRPAL=ACRPALX
I $L(ACRPAL,",")>11 D
.S ACRPAL=$P(ACRPAL,",",1,10)
.W !!,"ONLY 10 REPORTS CAN BE PRINTED AT ONCE. THE FOLLOWING HAVE BEEN SELECTED: "
.W !?5,ACRPAL
S ACRRTN="PALL^ACRFPALL"
S ZTDESC="PRINT SELECTED DOCUMENTS"
D ^ACRFZIS
Q
PALL F ACRPAL1=1:1 S ACRPAL2=$P(ACRPAL,",",ACRPAL1) Q:'ACRPAL2 I $D(ACRPRTX(ACRPAL2)),$D(^ACRDOC(ACRPAL2,0)) K ACRPRTX(ACRPAL2) D
.S (ACRDOCDA,ACRDOCDA)=ACRPAL2
.D SETDOC^ACRFEA1
.S ACRLBDA=$P(ACROBL0,U,3)
.I $D(ACRREQST),ACRREF'=116&(ACRREF'=130) S ACRREF=$S(ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210):116,ACRREF=600:130,ACRREF=148:148,1:"")
.S ACRREFX=ACRREF
.D ^ACRFQ
Q
ACRFPALL ;IHS/OIRM/DSD/THL,AEF - 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 DO EN1
EXIT KILL ACR,ACRPRTX
+1 QUIT
EN1 SET DIR(0)="LOA^1:99999"
+1 SET DIR("A")="Enter ID number(s): "
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EN2 ;EP;TO PRINT MULTIPLE DOCUMENTS
+1 SET ACRPAL=ACRY
+2 SET ACRPALX=""
+3 FOR ACRPAL1=1:1
SET ACRPAL2=$PIECE(ACRPAL,",",ACRPAL1)
IF 'ACRPAL2
QUIT
IF $DATA(ACRPRTX(ACRPAL2))
SET ACRPALX=ACRPALX_(ACRPAL2)_","
+4 SET ACRPAL=ACRPALX
+5 IF $LENGTH(ACRPAL,",")>11
Begin DoDot:1
+6 SET ACRPAL=$PIECE(ACRPAL,",",1,10)
+7 WRITE !!,"ONLY 10 REPORTS CAN BE PRINTED AT ONCE. THE FOLLOWING HAVE BEEN SELECTED: "
+8 WRITE !?5,ACRPAL
End DoDot:1
+9 SET ACRRTN="PALL^ACRFPALL"
+10 SET ZTDESC="PRINT SELECTED DOCUMENTS"
+11 DO ^ACRFZIS
+12 QUIT
PALL FOR ACRPAL1=1:1
SET ACRPAL2=$PIECE(ACRPAL,",",ACRPAL1)
IF 'ACRPAL2
QUIT
IF $DATA(ACRPRTX(ACRPAL2))
IF $DATA(^ACRDOC(ACRPAL2,0))
KILL ACRPRTX(ACRPAL2)
Begin DoDot:1
+1 SET (ACRDOCDA,ACRDOCDA)=ACRPAL2
+2 DO SETDOC^ACRFEA1
+3 SET ACRLBDA=$PIECE(ACROBL0,U,3)
+4 IF $DATA(ACRREQST)
IF ACRREF'=116&(ACRREF'=130)
SET ACRREF=$SELECT(ACRREF=103!(ACRREF=349)!(ACRREF=326)!(ACRREF=210):116,ACRREF=600:130,ACRREF=148:148,1:"")
+5 SET ACRREFX=ACRREF
+6 DO ^ACRFQ
End DoDot:1
+7 QUIT