- ACRFPRC2 ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS; [ 11/01/2001 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- ;;CONTINUATION OF ACRFPRCS
- CSI ;EP;DISPLAY APPROVAL STATUS
- D DISPLAY^ACRFTXTP
- D SELECT^ACRFTXTP Q:$D(ACRQUIT)!$D(ACROUT)
- S ACRX=0,ACRFDNO(1)=","
- F S ACRX=$O(^ACRLOCB("SEC",DUZ,ACRX)) Q:'ACRX S ACRFDNO(1)=ACRFDNO(1)_ACRX_","
- I ACRFDNO(1)="," D
- .W !!,"YOU DO NOT HAVE ACCESS TO ANY ACCOUNTS."
- .H 2
- .S ACRQUIT=""
- W !!
- S ACRAPVT=0
- F S ACRAPVT=$O(^ACRAPVS("ANXT",ACRAPVT)) Q:'ACRAPVT D
- .S ACRINDV=0
- .F S ACRINDV=$O(^ACRAPVS("ANXT",ACRAPVT,ACRINDV)) Q:'ACRINDV D
- ..S D0=0
- ..F S D0=$O(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)) Q:'D0!$D(ACRQUIT)!$D(ACROUT) D CSI2
- K ACRQUIT
- D PPO
- Q
- I 'ACRJ D
- .W !!,"NO ",@ACRON,$P(^ACRTXTYP(ACRTXDA,0),U),@ACROF," PENDING."
- .H 2
- Q
- CSI2 Q:'D0
- I '$D(^ACRAPVS(D0,0)),ACRINDV K ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0) Q
- S ACRDOCDA=+^ACRAPVS(D0,0)
- I '$D(^ACRDOC(ACRDOCDA,0)) D Q
- .S DA=D0
- .S DIK="^ACRAPVS("
- .D DIK^ACRFDIC
- .K ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)
- S ACRLBDA=","_$P(^ACRAPVS(D0,0),U,5)_","
- Q:$P(^ACRDOC(ACRDOCDA,0),U,4)'=ACRTXDA!(ACRFDNO(1)'[ACRLBDA)
- W !
- I '$D(^ACRAPVS("AB",ACRDOCDA)) W !,"DOCUMENT HAS NOT BEEN SUBMITTED FOR APPROVAL."
- E D
- .S ACRD0=0
- .F S ACRD0=$O(^ACRAPVS("AB",ACRDOCDA,ACRD0)) Q:'ACRD0 D
- ..S ACRAPVT=$P(^ACRAPVS(ACRD0,0),U,3)
- ..S ACRINDV=$P(^ACRAPVS(ACRD0,"DT"),U,2)
- ..I $D(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRD0)) D
- ...S D0=ACRD0
- ...N DXS,DIP,DC,DN
- ...D ^ACRPTTS
- I $D(ACRD0),'ACRD0 D
- .W !,"DOCUMENT PENDING IN PROCUREMENT."
- .K ACRD0
- K ACRAPVT,ACRINDV
- D PAUSE^ACRFWARN
- Q
- LIST S ACRDOCDA=+^ACRAPVS(D0,0)
- LIST1 S ACRJ=ACRJ+1
- S ACRDATA=^ACRDOC(ACRDOCDA,0)
- S ACRDOC=$P(ACRDATA,U)
- S ACRTXTYP=$P(ACRDATA,U,4)
- S:$D(ACRPPO1) ACRTXTYP=1
- K ACRPPO1
- S ACRREF=$P(^ACRTXTYP(ACRTXTYP,0),U,2)
- S ACRREF1=$P(^AUTTDOCR(ACRREF,0),U)
- S ACRID=$E($P(ACRDATA,U,14),1,15)
- S ^TMP("ACRDATA",$J,ACRJ)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_D0_U_ACRDOC_U_ACRID
- S ACRDATA1(ACRDOCDA)=""
- I $Y#IOSL>19,$E(IOST,1,2)="C-" D PAUSE^ACRFWARN W @IOF
- Q
- PPO I $D(^TMP("ACRDATA",$J))#2 D
- .S ACRX=0
- .F S ACRX=$O(^TMP("ACRDATA",$J,ACRX)) Q:'ACRX I '$D(ACRDATA1($P(^TMP("ACRDATA",$J,ACRX),U))) D PPH Q
- S ACRX=0
- F S ACRX=$O(^ACRDOC("PA",ACRX)) Q:'ACRX D
- .S D0=0
- .F S D0=$O(^ACRDOC("PA",ACRX,D0)) Q:'D0!$D(ACRQUIT)!$D(ACROUT) D
- .I '$D(ACRDATA1(D0)) D
- ..S ACRDOCDA=D0
- ..D:$P(^ACROBL(D0,"APV"),U,8)="" PPO1
- K ACRQUIT
- Q
- PPO1 S ACRLBDA=","_$P(^ACRDOC(D0,0),U,6)_","
- Q:$P(^ACRDOC(D0,0),U,4)'=11!(ACRFDNO(1)'[ACRLBDA)
- S ACRPPO1=""
- N DXS,DIP,DC,DN
- D ^ACRPTT2,LIST1
- I $Y#IOSL>19,$E(IOST,1,2)="C-" D PAUSE^ACRFWARN,PPH
- Q
- PPH W @IOF
- W !,"APPROVED REQUESTS AWAITING FURTHER PROCESSING."
- W !!
- Q
- EXIT ;EP;
- K ACRTXDA,ACRESIG,ACRCSI,ACRDAT,ACRX,ACRTXTYP,ACRJJ,ACRAPVT,ACRQUIT,ACRDA,ACR,ACRREF1,ACRMAX,ACRPA,ACRY,ACRAPDA,ACRLBDA,ACRNOW,ACRNUM,ACRORD,ACRSIG,ACRSIGG,ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRXMY,ACRINDV,ACRAP,ACRATTCH
- K ^TMP("ACRDATE",$J),^TMP("ACRALT",$J),^TMP("ACRALTDT",$J),^TMP("ACRDATA",$J)
- Q
- RESP ;EP;NOTIFITY INITIATOR THAT RESPONSE REQUIRED
- K ACRREQX
- N X,Y,Z,ACRREQ,J
- S X=0
- F S X=$O(^ACRAPVS("ANXT",X)) Q:'X D
- .W:$E($G(IOST),1,2)="C-" "."
- .S Y=0
- .F S Y=$O(^ACRAPVS("ANXT",X,Y)) Q:'Y D
- ..S Z=0
- ..F S Z=$O(^ACRAPVS("ANXT",X,Y,Z)) Q:'Z D
- ...S ACRDOCDA=+^ACRAPVS("ANXT",X,Y,Z)
- ...I $E($G(^ACRDOC(ACRDOCDA,"DT")),1,3)="1^0","^33^35^"[(U_$P($G(^(0)),U,13)_U) D
- ....S ACRREQ=U_$P($G(^ACRDOC(ACRDOCDA,"REQ")),U,12)_U_$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,8)_U_$P($G(^ACROBL(ACRDOCDA,0)),U,5)_U
- ....Q:ACRREQ'[(U_DUZ_U)
- ....S ACRREQX($P(^ACRDOC(ACRDOCDA,0),U,6),ACRDOCDA)=""
- Q:'$D(ACRREQX)
- W *7,*7
- W !!?5,"The following document(s) were returned for change or clarification."
- W !?5,"You must respond before they can be signed and processed further."
- W !?5,"Under 'USER MENU' use 'ER' (Edit Pending Request). Select the"
- W !?5,"Department Account, make the requested changes AND send the"
- W !?5,"REQUIRED response."
- W !!?5,"ID NO."
- W ?13,"Department Account"
- W !?5,"------"
- W ?13,"--------------------"
- S X=0
- F S X=$O(ACRREQX(X)) Q:'X I $D(^ACRLOCB(X,0)) S Z=^(0) D
- .W !?5,X
- .W ?13,$P($G(^AUTTPRG(+$P(Z,U,5),0)),U)
- .W !!?13,"ID NO."
- .W ?21,"DOCUMENT"
- .W ?58,"IDENTIFIER"
- .W !?13,"------"
- .W ?21,"------------------------------"
- .W ?58,"---------------"
- .S Y=0
- .F S Y=$O(ACRREQX(X,Y)) Q:'Y I $D(^ACRDOC(Y,0)) S J=^(0) D
- ..W !?13,Y
- ..W ?21,$P(J,U)
- ..W ?$X+2,"(",$P(J,U,2),")"
- ..W ?58,$P(J,U,14)
- D PAUSE^ACRFWARN
- Q
- ATTACH ;EP;DISPLAY ATTACHMENT MESSAGE
- EDIT K ACRRR
- S ACRATTCH=$G(^ACRDOC(ACRDOCDA,3))
- S ACRATTCH=$P(ACRATTCH,U,9)
- I 'ACRATTCH D Q
- .W !!,"There are NO attachments for this document"
- .D PAUSE^ACRFWARN
- .K ACRATTCH
- N X
- S X=ACRATTCH
- W !!,*7,*7,"There ",$S(X>1:"are ",1:"is "),ACRATTCH," physical attachment",$S(X>1:"s",1:"")," which pertain",$S(X>1:"",1:"s")
- W " to this request."
- W !,"Please find and review ",$S(X>1:"them",1:"it")," if ",$S(X>1:"they",1:"it")," affect",$S(X>1:"",1:"s")," your approval of this request."
- I $D(^ACRDOC(ACRDOCDA,10,0)),$P(^(0),U,3)>0 D
- .W !!,"Th",$S(X>1:"ese",1:"is")," attachment",$S(X>1:"s",1:""),$S(X>1:" are",1:" is")," described as follows:"
- .W !,"--------------------------------------------------------------------------------"
- .N X,J
- .S X=0
- .F J=1:1 S X=$O(^ACRDOC(ACRDOCDA,10,X)) Q:'X I $D(^ACRDOC(ACRDOCDA,10,X,0)) D
- ..W !,^ACRDOC(ACRDOCDA,10,X,0)
- ..I J#15=0 D
- ...S ACRX=X
- ...D PAUSE^ACRFWARN
- ...S X=ACRX
- Q
- ACRFPRC2 ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS; [ 11/01/2001 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- +2 ;;CONTINUATION OF ACRFPRCS
- CSI ;EP;DISPLAY APPROVAL STATUS
- +1 DO DISPLAY^ACRFTXTP
- +2 DO SELECT^ACRFTXTP
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +3 SET ACRX=0
- SET ACRFDNO(1)=","
- +4 FOR
- SET ACRX=$ORDER(^ACRLOCB("SEC",DUZ,ACRX))
- IF 'ACRX
- QUIT
- SET ACRFDNO(1)=ACRFDNO(1)_ACRX_","
- +5 IF ACRFDNO(1)=","
- Begin DoDot:1
- +6 WRITE !!,"YOU DO NOT HAVE ACCESS TO ANY ACCOUNTS."
- +7 HANG 2
- +8 SET ACRQUIT=""
- End DoDot:1
- +9 WRITE !!
- +10 SET ACRAPVT=0
- +11 FOR
- SET ACRAPVT=$ORDER(^ACRAPVS("ANXT",ACRAPVT))
- IF 'ACRAPVT
- QUIT
- Begin DoDot:1
- +12 SET ACRINDV=0
- +13 FOR
- SET ACRINDV=$ORDER(^ACRAPVS("ANXT",ACRAPVT,ACRINDV))
- IF 'ACRINDV
- QUIT
- Begin DoDot:2
- +14 SET D0=0
- +15 FOR
- SET D0=$ORDER(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0))
- IF 'D0!$DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- DO CSI2
- End DoDot:2
- End DoDot:1
- +16 KILL ACRQUIT
- +17 DO PPO
- +18 QUIT
- +19 IF 'ACRJ
- Begin DoDot:1
- +20 WRITE !!,"NO ",@ACRON,$PIECE(^ACRTXTYP(ACRTXDA,0),U),@ACROF," PENDING."
- +21 HANG 2
- End DoDot:1
- +22 QUIT
- CSI2 IF 'D0
- QUIT
- +1 IF '$DATA(^ACRAPVS(D0,0))
- IF ACRINDV
- KILL ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)
- QUIT
- +2 SET ACRDOCDA=+^ACRAPVS(D0,0)
- +3 IF '$DATA(^ACRDOC(ACRDOCDA,0))
- Begin DoDot:1
- +4 SET DA=D0
- +5 SET DIK="^ACRAPVS("
- +6 DO DIK^ACRFDIC
- +7 KILL ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)
- End DoDot:1
- QUIT
- +8 SET ACRLBDA=","_$PIECE(^ACRAPVS(D0,0),U,5)_","
- +9 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)'=ACRTXDA!(ACRFDNO(1)'[ACRLBDA)
- QUIT
- +10 WRITE !
- +11 IF '$DATA(^ACRAPVS("AB",ACRDOCDA))
- WRITE !,"DOCUMENT HAS NOT BEEN SUBMITTED FOR APPROVAL."
- +12 IF '$TEST
- Begin DoDot:1
- +13 SET ACRD0=0
- +14 FOR
- SET ACRD0=$ORDER(^ACRAPVS("AB",ACRDOCDA,ACRD0))
- IF 'ACRD0
- QUIT
- Begin DoDot:2
- +15 SET ACRAPVT=$PIECE(^ACRAPVS(ACRD0,0),U,3)
- +16 SET ACRINDV=$PIECE(^ACRAPVS(ACRD0,"DT"),U,2)
- +17 IF $DATA(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRD0))
- Begin DoDot:3
- +18 SET D0=ACRD0
- +19 NEW DXS,DIP,DC,DN
- +20 DO ^ACRPTTS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 IF $DATA(ACRD0)
- IF 'ACRD0
- Begin DoDot:1
- +22 WRITE !,"DOCUMENT PENDING IN PROCUREMENT."
- +23 KILL ACRD0
- End DoDot:1
- +24 KILL ACRAPVT,ACRINDV
- +25 DO PAUSE^ACRFWARN
- +26 QUIT
- LIST SET ACRDOCDA=+^ACRAPVS(D0,0)
- LIST1 SET ACRJ=ACRJ+1
- +1 SET ACRDATA=^ACRDOC(ACRDOCDA,0)
- +2 SET ACRDOC=$PIECE(ACRDATA,U)
- +3 SET ACRTXTYP=$PIECE(ACRDATA,U,4)
- +4 IF $DATA(ACRPPO1)
- SET ACRTXTYP=1
- +5 KILL ACRPPO1
- +6 SET ACRREF=$PIECE(^ACRTXTYP(ACRTXTYP,0),U,2)
- +7 SET ACRREF1=$PIECE(^AUTTDOCR(ACRREF,0),U)
- +8 SET ACRID=$EXTRACT($PIECE(ACRDATA,U,14),1,15)
- +9 SET ^TMP("ACRDATA",$JOB,ACRJ)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_D0_U_ACRDOC_U_ACRID
- +10 SET ACRDATA1(ACRDOCDA)=""
- +11 IF $Y#IOSL>19
- IF $EXTRACT(IOST,1,2)="C-"
- DO PAUSE^ACRFWARN
- WRITE @IOF
- +12 QUIT
- PPO IF $DATA(^TMP("ACRDATA",$JOB))#2
- Begin DoDot:1
- +1 SET ACRX=0
- +2 FOR
- SET ACRX=$ORDER(^TMP("ACRDATA",$JOB,ACRX))
- IF 'ACRX
- QUIT
- IF '$DATA(ACRDATA1($PIECE(^TMP("ACRDATA",$JOB,ACRX),U)))
- DO PPH
- QUIT
- End DoDot:1
- +3 SET ACRX=0
- +4 FOR
- SET ACRX=$ORDER(^ACRDOC("PA",ACRX))
- IF 'ACRX
- QUIT
- Begin DoDot:1
- +5 SET D0=0
- +6 FOR
- SET D0=$ORDER(^ACRDOC("PA",ACRX,D0))
- IF 'D0!$DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- Begin DoDot:2
- End DoDot:2
- +7 IF '$DATA(ACRDATA1(D0))
- Begin DoDot:2
- +8 SET ACRDOCDA=D0
- +9 IF $PIECE(^ACROBL(D0,"APV"),U,8)=""
- DO PPO1
- End DoDot:2
- End DoDot:1
- +10 KILL ACRQUIT
- +11 QUIT
- PPO1 SET ACRLBDA=","_$PIECE(^ACRDOC(D0,0),U,6)_","
- +1 IF $PIECE(^ACRDOC(D0,0),U,4)'=11!(ACRFDNO(1)'[ACRLBDA)
- QUIT
- +2 SET ACRPPO1=""
- +3 NEW DXS,DIP,DC,DN
- +4 DO ^ACRPTT2
- DO LIST1
- +5 IF $Y#IOSL>19
- IF $EXTRACT(IOST,1,2)="C-"
- DO PAUSE^ACRFWARN
- DO PPH
- +6 QUIT
- PPH WRITE @IOF
- +1 WRITE !,"APPROVED REQUESTS AWAITING FURTHER PROCESSING."
- +2 WRITE !!
- +3 QUIT
- EXIT ;EP;
- +1 KILL ACRTXDA,ACRESIG,ACRCSI,ACRDAT,ACRX,ACRTXTYP,ACRJJ,ACRAPVT,ACRQUIT,ACRDA,ACR,ACRREF1,ACRMAX,ACRPA,ACRY,ACRAPDA,ACRLBDA,ACRNOW,ACRNUM,ACRORD,ACRSIG,ACRSIGG,ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRXMY,ACRINDV,ACRAP,ACRATTCH
- +2 KILL ^TMP("ACRDATE",$JOB),^TMP("ACRALT",$JOB),^TMP("ACRALTDT",$JOB),^TMP("ACRDATA",$JOB)
- +3 QUIT
- RESP ;EP;NOTIFITY INITIATOR THAT RESPONSE REQUIRED
- +1 KILL ACRREQX
- +2 NEW X,Y,Z,ACRREQ,J
- +3 SET X=0
- +4 FOR
- SET X=$ORDER(^ACRAPVS("ANXT",X))
- IF 'X
- QUIT
- Begin DoDot:1
- +5 IF $EXTRACT($GET(IOST),1,2)="C-"
- WRITE "."
- +6 SET Y=0
- +7 FOR
- SET Y=$ORDER(^ACRAPVS("ANXT",X,Y))
- IF 'Y
- QUIT
- Begin DoDot:2
- +8 SET Z=0
- +9 FOR
- SET Z=$ORDER(^ACRAPVS("ANXT",X,Y,Z))
- IF 'Z
- QUIT
- Begin DoDot:3
- +10 SET ACRDOCDA=+^ACRAPVS("ANXT",X,Y,Z)
- +11 IF $EXTRACT($GET(^ACRDOC(ACRDOCDA,"DT")),1,3)="1^0"
- IF "^33^35^"[(U_$PIECE($GET(^(0)),U,13)_U)
- Begin DoDot:4
- +12 SET ACRREQ=U_$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ")),U,12)_U_$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,8)_U_$PIECE($GET(^ACROBL(ACRDOCDA,0)),U,5)_U
- +13 IF ACRREQ'[(U_DUZ_U)
- QUIT
- +14 SET ACRREQX($PIECE(^ACRDOC(ACRDOCDA,0),U,6),ACRDOCDA)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 IF '$DATA(ACRREQX)
- QUIT
- +16 WRITE *7,*7
- +17 WRITE !!?5,"The following document(s) were returned for change or clarification."
- +18 WRITE !?5,"You must respond before they can be signed and processed further."
- +19 WRITE !?5,"Under 'USER MENU' use 'ER' (Edit Pending Request). Select the"
- +20 WRITE !?5,"Department Account, make the requested changes AND send the"
- +21 WRITE !?5,"REQUIRED response."
- +22 WRITE !!?5,"ID NO."
- +23 WRITE ?13,"Department Account"
- +24 WRITE !?5,"------"
- +25 WRITE ?13,"--------------------"
- +26 SET X=0
- +27 FOR
- SET X=$ORDER(ACRREQX(X))
- IF 'X
- QUIT
- IF $DATA(^ACRLOCB(X,0))
- SET Z=^(0)
- Begin DoDot:1
- +28 WRITE !?5,X
- +29 WRITE ?13,$PIECE($GET(^AUTTPRG(+$PIECE(Z,U,5),0)),U)
- +30 WRITE !!?13,"ID NO."
- +31 WRITE ?21,"DOCUMENT"
- +32 WRITE ?58,"IDENTIFIER"
- +33 WRITE !?13,"------"
- +34 WRITE ?21,"------------------------------"
- +35 WRITE ?58,"---------------"
- +36 SET Y=0
- +37 FOR
- SET Y=$ORDER(ACRREQX(X,Y))
- IF 'Y
- QUIT
- IF $DATA(^ACRDOC(Y,0))
- SET J=^(0)
- Begin DoDot:2
- +38 WRITE !?13,Y
- +39 WRITE ?21,$PIECE(J,U)
- +40 WRITE ?$X+2,"(",$PIECE(J,U,2),")"
- +41 WRITE ?58,$PIECE(J,U,14)
- End DoDot:2
- End DoDot:1
- +42 DO PAUSE^ACRFWARN
- +43 QUIT
- ATTACH ;EP;DISPLAY ATTACHMENT MESSAGE
- EDIT KILL ACRRR
- +1 SET ACRATTCH=$GET(^ACRDOC(ACRDOCDA,3))
- +2 SET ACRATTCH=$PIECE(ACRATTCH,U,9)
- +3 IF 'ACRATTCH
- Begin DoDot:1
- +4 WRITE !!,"There are NO attachments for this document"
- +5 DO PAUSE^ACRFWARN
- +6 KILL ACRATTCH
- End DoDot:1
- QUIT
- +7 NEW X
- +8 SET X=ACRATTCH
- +9 WRITE !!,*7,*7,"There ",$SELECT(X>1:"are ",1:"is "),ACRATTCH," physical attachment",$SELECT(X>1:"s",1:"")," which pertain",$SELECT(X>1:"",1:"s")
- +10 WRITE " to this request."
- +11 WRITE !,"Please find and review ",$SELECT(X>1:"them",1:"it")," if ",$SELECT(X>1:"they",1:"it")," affect",$SELECT(X>1:"",1:"s")," your approval of this request."
- +12 IF $DATA(^ACRDOC(ACRDOCDA,10,0))
- IF $PIECE(^(0),U,3)>0
- Begin DoDot:1
- +13 WRITE !!,"Th",$SELECT(X>1:"ese",1:"is")," attachment",$SELECT(X>1:"s",1:""),$SELECT(X>1:" are",1:" is")," described as follows:"
- +14 WRITE !,"--------------------------------------------------------------------------------"
- +15 NEW X,J
- +16 SET X=0
- +17 FOR J=1:1
- SET X=$ORDER(^ACRDOC(ACRDOCDA,10,X))
- IF 'X
- QUIT
- IF $DATA(^ACRDOC(ACRDOCDA,10,X,0))
- Begin DoDot:2
- +18 WRITE !,^ACRDOC(ACRDOCDA,10,X,0)
- +19 IF J#15=0
- Begin DoDot:3
- +20 SET ACRX=X
- +21 DO PAUSE^ACRFWARN
- +22 SET X=ACRX
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 QUIT
