- 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