ACHSPAC ; IHS/ITSC/JVK - VIEW/PRINT DOCUMENTS FOR A PATIENT ACC NO ; [ 01/26/2005 10:53 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
;
;12/4/00 pmf add two lines for special pawnee benefit
;1/4/04 ITSC/SET/JVK mod for special pawnee benefit
K A,DFN
I $P($G(^AUTTLOC(DUZ(2),0)),U,10)=505613 S ACHSYAYA=U_"AZO"_"PWN"_"LK" D @ACHSYAYA K ACHSYAYA Q:'$D(DFN)
;
PAT ;
;ITSC/SET/JVK ACHS*3.1*12 FOR IHS/OKCAO/POC PAWNEE BEN PKG
I $P($G(^AUTTLOC(DUZ(2),0)),U,10)=505613 S ACHSYAYA=U_"AZO"_"PWN"_"LK" D @ACHSYAYA K ACHSYAYA Q:'$D(DFN)
;D PTLK^ACHS
I $P($G(^AUTTLOC(DUZ(2),0)),U,10)'=505613 D PTLK^ACHS
I '$D(DFN) D K Q
I '$D(^ACHSF(DUZ(2),"PB",DFN)) W *7,!!,"This patient has no CHS documents on file.",! G PAT
S ACHSIO=IO
BDT ;
S ACHSBDT=$$DATE^ACHS("B","DOCUMENTS FOR A PATIENT")
I ACHSBDT<1 D K Q
EDT ;
S ACHSEDT=$$DATE^ACHS("E","DOCUMENTS FOR A PATIENT")
I ACHSEDT<1 D K Q
I $$EBB^ACHS(ACHSBDT,ACHSEDT) G BDT
B ;
W !!,"TYPE of service:"
S ACHSTOS=$P(^DD(9002080.01,3,0),U,3)
F ACHS=1:1 S ACHS(ACHS)=$P(ACHSTOS,";",ACHS) Q:ACHS(ACHS)="" W ?20,$P(ACHS(ACHS),":",1)," ",$P(ACHS(ACHS),":",2),!
W !,"Select TYPE of service (1 - ",ACHS-1," 'A' = 'ALL') ALL // "
D READ^ACHSFU
I $D(DTOUT) D K Q
G BDT:$D(DUOUT)
S:(Y="") Y="A"
G B3:Y="A"
I ($E(Y)="?")!(Y<1)!(Y>(ACHS-1)) W !!,"Enter an ""A"" to view documents for all types of service,",!,"otherwise, enter a number from 1 to ",ACHS-1,".",! G B
B3 ;
S ACHSRPT=$S(Y="A":"ALL",1:+Y)
DEV ;
S %ZIS="OPQ"
D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
I POP D HOME^%ZIS D K Q
G:'$D(IO("Q")) START
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S ZTRTN="START^ACHSPDC",ZTDESC="CHS Patient "_ACHSRPT_" Summary, "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)_" for "_$P(^DPT(DFN,0),U)
F %="ACHSBDT","DFN","ACHSEDT","ACHSRPT" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
K ZTSK
D K
Q
;
START ;EP - From TaskMan.
D FC^ACHSUF
I $G(ACHSERR) D K Q
S (ACHSTOT,ACHSCANC,ACHSCTOT,ACHSTOT("$"),ACHSDOC)=0
S ACHST1=$$C^XBFUNC("PATIENT: "_$P($G(^DPT(DFN,0)),U)_" CHART #: "_$$HRN^ACHS(DFN,DUZ(2)),80)
S ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)
S ACHSTOS=$P($G(^DD(9002080.01,3,0)),U,3)
S ACHSSTS=$P(^DD(9002080.01,11,0),U,3)
S ACHST3=$$C^XBFUNC($S(ACHSRPT:$P($P(ACHSTOS,";",ACHSRPT),":",2)_" documents ONLY",1:"All Documents"),80)
D BRPT^ACHSFU
X:$D(IO("S")) ACHSPPO
D HDR
K ACHSDVEW
S ACHSVQIT=0
S ACHSFAC=$P($G(^AUTTLOC($O(^AUTTLOC("B",DUZ(2),0)),0)),U,10)
A ; Main loop.
S ACHSDOC=$O(^ACHSF(DUZ(2),"PB",DFN,ACHSDOC))
I ACHSDOC="" D END Q
S ACHSDOC0=$G(^ACHSF(DUZ(2),"D",ACHSDOC,0))
I ACHSDOC0="" W !!,"NO DOCUMENT ZERO NODE FOR X-REF PB FOR FACILITY: "_DUZ(2)_" DOCUMENT IEN: "_ACHSDOC_" PATIENT DFN: "_DFN W !!,"PLEASE NOTIFY YOUR SITE MANAGER IMMEDIATELY!!" W !! D RTRN^ACHS D K Q
G A:+$P(ACHSDOC0,U,2)<ACHSBDT,A:+$P(ACHSDOC0,U,2)>ACHSEDT,A:(ACHSRPT'="ALL")&(ACHSRPT'=$P(ACHSDOC0,U,4))
;ITSC/SET/JVK ACHS*3.1*12
;W $P(ACHSDOC0,U,14),ACHSFC,$P(ACHSDOC0,U)
W $P(ACHSDOC0,U,14),"-",$P(ACHSDOC0,U)
K Y
;ITSC/SET/JVK ACHS*3.1*12
S ACHSPAC=$P($G(^ACHSF(DUZ(2),"D",ACHSDOC,1)),U,3)
W ?8,ACHSPAC
I $D(^ACHSF(DUZ(2),"D",ACHSDOC,3)),+$P($G(^ACHSF(DUZ(2),"D",ACHSDOC,3)),U)>0 S Y=+$P(^(3),U)
S:'$D(Y) Y=+$P(ACHSDOC0,U,2)
;ITSC/SET/JVK ACHS*3.1*12
;W ?17,$E(Y,2,7)
W ?24,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
;I $P(ACHSDOC0,U,8),$D(^AUTTVNDR($P(ACHSDOC0,U,8),0)) W ?24,$E($P(^(0),U),1,22)
I $P(ACHSDOC0,U,8),$D(^AUTTVNDR($P(ACHSDOC0,U,8),0)) W ?34,$E($P(^(0),U),1,22)
;W ?47,$E($P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2),1,2)
W ?58,$E($P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2),1,2)
;ITSC/SET/JVK ACHS*3.1*12 END OF CHANGES
I $D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")) S X=$S($D(^("ZA")):+^("ZA"),1:+^("PA")) G P6
S X=$S($D(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")):+^("PA"),1:$P(ACHSDOC0,U,9))
I $P(ACHSDOC0,U,12)=4 S X=0,ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0)) F Q:+ACHS=0 S X=+$P(^(ACHS,0),U,4),ACHS=$O(^ACHSF(DUZ(2),"D",ACHSDOC,"T",ACHS))
I $P(ACHSDOC0,U,12)=4 S ACHSCANC=ACHSCANC+X
P6 ;
I $P(ACHSDOC0,U,12)]"" W ?61,$P($P(ACHSSTS,";",$P(ACHSDOC0,U,12)+1),":",2)
S ACHSTOT("$")=ACHSTOT("$")+X
S ACHSCTOT=ACHSTOT("$")-ACHSCANC
W ?66,$J($FN(X,",",2),12),!
I IOST["C-",$Y>24 G DISPLAY
I IOST'["C-",($Y>ACHSBM) D CPI^ACHS D RTRN^ACHS G K:$G(ACHSQUIT) D HDR
S ACHSTOT=ACHSTOT+1
G A
;
END ;
W ?69,"----------",!,"Total documents seen: ",$FN(ACHSTOT,","),?66,$J("$"_$FN(ACHSTOT("$"),",",2),12),!!?45,"LESS CANCELS",?66,$J($FN(-ACHSCANC,",P",2),13),!?69,"==========",!?66,$J("$"_$FN(ACHSCTOT,",",2),12)
I IOST["C-",$Y>15 S ACHSVQIT=1 D DISPLAY
D:IOST'["C-" CPI^ACHS
K ;EP - Kill vars, do ERPT, quit.
K ACHSFAC,ACHSPPC,ACHSPPO,DFN,ACHSDOC0,ACHSDOC,ACHSSTS,ACHSTOS,ACHSTOT,ACHSDVEW,ACHSVQIT,ACHSCANC,ACHSCTOT
D ERPT^ACHS ;CLOSES ALL DEVICES
Q
;
HDR ; Print header.
S ACHSPG=ACHSPG+1
W @IOF
D CPI^ACHS:IOST'["C-"
W !,$$REPEAT^XLFSTR("*",79),!,$$C^XBFUNC("CHS DOCUMENTS FOR A SPECIFIC PATIENT",80),!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHST1,!,ACHST2,!,ACHST3,!,?34,$P(^DIC(4,DUZ(2),0),U),!,$$REPEAT^XLFSTR("*",79)
;ITSC/SET/JVK ACHS*3.1*12
;W !,"FAC",?7,"DOCUMENT",?17,"DATED",?24,"VENDOR",?47,"TYPE",?52,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!
W !,"DOC #",?7,"ACC #",?24,"DATED",?34,"VENDOR",?55,"TYPE",?61,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!
Q
;
DISPLAY ; View document selected from the report.
K DIR
S DIR(0)="Y",DIR("A")="Do you want to view one of the documents listed",DIR("B")="NO"
D ^DIR
K DIR
I Y=0,ACHSVQIT=0 D HDR S ACHSTOT=ACHSTOT+1 G A
I Y=0 Q
I ACHSVQIT=1,Y=0,ACHSPG>1,$Y>24 G AGAIN
S ACHSDVEW=0
D
. N DFN,ACHSDOC
. D ^ACHSAD
.Q
K DIR
S DIR(0)="E"
W !!
D ^DIR
G K:Y=0
I ACHSVQIT'=1 D HDR G A
AGAIN ;
K DIR
S DIR(0)="Y",DIR("A")="View document list again",DIR("B")="NO"
W !!!
D ^DIR
I Y=1 S (ACHSCANC,ACHSVQIT,ACHSTOT,ACHSTOT("$"),ACHSPG)=0,ACHSDOC="" D HDR G A
G K
;
ACHSPAC ; IHS/ITSC/JVK - VIEW/PRINT DOCUMENTS FOR A PATIENT ACC NO ; [ 01/26/2005 10:53 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**12**;JUN 11, 2001
+2 ;
+3 ;12/4/00 pmf add two lines for special pawnee benefit
+4 ;1/4/04 ITSC/SET/JVK mod for special pawnee benefit
+5 KILL A,DFN
+6 IF $PIECE($GET(^AUTTLOC(DUZ(2),0)),U,10)=505613
SET ACHSYAYA=U_"AZO"_"PWN"_"LK"
DO @ACHSYAYA
KILL ACHSYAYA
IF '$DATA(DFN)
QUIT
+7 ;
PAT ;
+1 ;ITSC/SET/JVK ACHS*3.1*12 FOR IHS/OKCAO/POC PAWNEE BEN PKG
+2 IF $PIECE($GET(^AUTTLOC(DUZ(2),0)),U,10)=505613
SET ACHSYAYA=U_"AZO"_"PWN"_"LK"
DO @ACHSYAYA
KILL ACHSYAYA
IF '$DATA(DFN)
QUIT
+3 ;D PTLK^ACHS
+4 IF $PIECE($GET(^AUTTLOC(DUZ(2),0)),U,10)'=505613
DO PTLK^ACHS
+5 IF '$DATA(DFN)
DO K
QUIT
+6 IF '$DATA(^ACHSF(DUZ(2),"PB",DFN))
WRITE *7,!!,"This patient has no CHS documents on file.",!
GOTO PAT
+7 SET ACHSIO=IO
BDT ;
+1 SET ACHSBDT=$$DATE^ACHS("B","DOCUMENTS FOR A PATIENT")
+2 IF ACHSBDT<1
DO K
QUIT
EDT ;
+1 SET ACHSEDT=$$DATE^ACHS("E","DOCUMENTS FOR A PATIENT")
+2 IF ACHSEDT<1
DO K
QUIT
+3 IF $$EBB^ACHS(ACHSBDT,ACHSEDT)
GOTO BDT
B ;
+1 WRITE !!,"TYPE of service:"
+2 SET ACHSTOS=$PIECE(^DD(9002080.01,3,0),U,3)
+3 FOR ACHS=1:1
SET ACHS(ACHS)=$PIECE(ACHSTOS,";",ACHS)
IF ACHS(ACHS)=""
QUIT
WRITE ?20,$PIECE(ACHS(ACHS),":",1)," ",$PIECE(ACHS(ACHS),":",2),!
+4 WRITE !,"Select TYPE of service (1 - ",ACHS-1," 'A' = 'ALL') ALL // "
+5 DO READ^ACHSFU
+6 IF $DATA(DTOUT)
DO K
QUIT
+7 IF $DATA(DUOUT)
GOTO BDT
+8 IF (Y="")
SET Y="A"
+9 IF Y="A"
GOTO B3
+10 IF ($EXTRACT(Y)="?")!(Y<1)!(Y>(ACHS-1))
WRITE !!,"Enter an ""A"" to view documents for all types of service,",!,"otherwise, enter a number from 1 to ",ACHS-1,".",!
GOTO B
B3 ;
+1 SET ACHSRPT=$SELECT(Y="A":"ALL",1:+Y)
DEV ;
+1 SET %ZIS="OPQ"
+2 DO ^%ZIS
IF $DATA(IO("S"))
DO SLV^ACHSFU
+3 IF POP
DO HOME^%ZIS
DO K
QUIT
+4 IF '$DATA(IO("Q"))
GOTO START
+5 KILL IO("Q")
+6 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+7 SET ZTRTN="START^ACHSPDC"
SET ZTDESC="CHS Patient "_ACHSRPT_" Summary, "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)_" for "_$PIECE(^DPT(DFN,0),U)
+8 FOR %="ACHSBDT","DFN","ACHSEDT","ACHSRPT"
SET ZTSAVE(%)=""
+9 DO ^%ZTLOAD
+10 IF '$DATA(ZTSK)
GOTO DEV
+11 KILL ZTSK
+12 DO K
+13 QUIT
+14 ;
START ;EP - From TaskMan.
+1 DO FC^ACHSUF
+2 IF $GET(ACHSERR)
DO K
QUIT
+3 SET (ACHSTOT,ACHSCANC,ACHSCTOT,ACHSTOT("$"),ACHSDOC)=0
+4 SET ACHST1=$$C^XBFUNC("PATIENT: "_$PIECE($GET(^DPT(DFN,0)),U)_" CHART #: "_$$HRN^ACHS(DFN,DUZ(2)),80)
+5 SET ACHST2=$$C^XBFUNC("For the period "_$$FMTE^XLFDT(ACHSBDT)_" through "_$$FMTE^XLFDT(ACHSEDT),80)
+6 SET ACHSTOS=$PIECE($GET(^DD(9002080.01,3,0)),U,3)
+7 SET ACHSSTS=$PIECE(^DD(9002080.01,11,0),U,3)
+8 SET ACHST3=$$C^XBFUNC($SELECT(ACHSRPT:$PIECE($PIECE(ACHSTOS,";",ACHSRPT),":",2)_" documents ONLY",1:"All Documents"),80)
+9 DO BRPT^ACHSFU
+10 IF $DATA(IO("S"))
XECUTE ACHSPPO
+11 DO HDR
+12 KILL ACHSDVEW
+13 SET ACHSVQIT=0
+14 SET ACHSFAC=$PIECE($GET(^AUTTLOC($ORDER(^AUTTLOC("B",DUZ(2),0)),0)),U,10)
A ; Main loop.
+1 SET ACHSDOC=$ORDER(^ACHSF(DUZ(2),"PB",DFN,ACHSDOC))
+2 IF ACHSDOC=""
DO END
QUIT
+3 SET ACHSDOC0=$GET(^ACHSF(DUZ(2),"D",ACHSDOC,0))
+4 IF ACHSDOC0=""
WRITE !!,"NO DOCUMENT ZERO NODE FOR X-REF PB FOR FACILITY: "_DUZ(2)_" DOCUMENT IEN: "_ACHSDOC_" PATIENT DFN: "_DFN
WRITE !!,"PLEASE NOTIFY YOUR SITE MANAGER IMMEDIATELY!!"
WRITE !!
DO RTRN^ACHS
DO K
QUIT
+5 IF +$PIECE(ACHSDOC0,U,2)<ACHSBDT
GOTO A
IF +$PIECE(ACHSDOC0,U,2)>ACHSEDT
GOTO A
IF (ACHSRPT'="ALL")&(ACHSRPT'=$PIECE(ACHSDOC0,U,4))
GOTO A
+6 ;ITSC/SET/JVK ACHS*3.1*12
+7 ;W $P(ACHSDOC0,U,14),ACHSFC,$P(ACHSDOC0,U)
+8 WRITE $PIECE(ACHSDOC0,U,14),"-",$PIECE(ACHSDOC0,U)
+9 KILL Y
+10 ;ITSC/SET/JVK ACHS*3.1*12
+11 SET ACHSPAC=$PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDOC,1)),U,3)
+12 WRITE ?8,ACHSPAC
+13 IF $DATA(^ACHSF(DUZ(2),"D",ACHSDOC,3))
IF +$PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDOC,3)),U)>0
SET Y=+$PIECE(^(3),U)
+14 IF '$DATA(Y)
SET Y=+$PIECE(ACHSDOC0,U,2)
+15 ;ITSC/SET/JVK ACHS*3.1*12
+16 ;W ?17,$E(Y,2,7)
+17 WRITE ?24,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+18 ;I $P(ACHSDOC0,U,8),$D(^AUTTVNDR($P(ACHSDOC0,U,8),0)) W ?24,$E($P(^(0),U),1,22)
+19 IF $PIECE(ACHSDOC0,U,8)
IF $DATA(^AUTTVNDR($PIECE(ACHSDOC0,U,8),0))
WRITE ?34,$EXTRACT($PIECE(^(0),U),1,22)
+20 ;W ?47,$E($P($P(ACHSTOS,";",$P(ACHSDOC0,U,4)),":",2),1,2)
+21 WRITE ?58,$EXTRACT($PIECE($PIECE(ACHSTOS,";",$PIECE(ACHSDOC0,U,4)),":",2),1,2)
+22 ;ITSC/SET/JVK ACHS*3.1*12 END OF CHANGES
+23 IF $DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"PA"))
SET X=$SELECT($DATA(^("ZA")):+^("ZA"),1:+^("PA"))
GOTO P6
+24 SET X=$SELECT($DATA(^ACHSF(DUZ(2),"D",ACHSDOC,"PA")):+^("PA"),1:$PIECE(ACHSDOC0,U,9))
+25 IF $PIECE(ACHSDOC0,U,12)=4
SET X=0
SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDOC,"T",0))
FOR
IF +ACHS=0
QUIT
SET X=+$PIECE(^(ACHS,0),U,4)
SET ACHS=$ORDER(^ACHSF(DUZ(2),"D",ACHSDOC,"T",ACHS))
+26 IF $PIECE(ACHSDOC0,U,12)=4
SET ACHSCANC=ACHSCANC+X
P6 ;
+1 IF $PIECE(ACHSDOC0,U,12)]""
WRITE ?61,$PIECE($PIECE(ACHSSTS,";",$PIECE(ACHSDOC0,U,12)+1),":",2)
+2 SET ACHSTOT("$")=ACHSTOT("$")+X
+3 SET ACHSCTOT=ACHSTOT("$")-ACHSCANC
+4 WRITE ?66,$JUSTIFY($FNUMBER(X,",",2),12),!
+5 IF IOST["C-"
IF $Y>24
GOTO DISPLAY
+6 IF IOST'["C-"
IF ($Y>ACHSBM)
DO CPI^ACHS
DO RTRN^ACHS
IF $GET(ACHSQUIT)
GOTO K
DO HDR
+7 SET ACHSTOT=ACHSTOT+1
+8 GOTO A
+9 ;
END ;
+1 WRITE ?69,"----------",!,"Total documents seen: ",$FNUMBER(ACHSTOT,","),?66,$JUSTIFY("$"_$FNUMBER(ACHSTOT("$"),",",2),12),!!?45,"LESS CANCELS",?66,$JUSTIFY($FNUMBER(-ACHSCANC,",P",2),13),!?69,"==========",!?66,$JUSTIFY("$"_$FNUMBER(ACHSCTOT,","
,2),12)
+2 IF IOST["C-"
IF $Y>15
SET ACHSVQIT=1
DO DISPLAY
+3 IF IOST'["C-"
DO CPI^ACHS
K ;EP - Kill vars, do ERPT, quit.
+1 KILL ACHSFAC,ACHSPPC,ACHSPPO,DFN,ACHSDOC0,ACHSDOC,ACHSSTS,ACHSTOS,ACHSTOT,ACHSDVEW,ACHSVQIT,ACHSCANC,ACHSCTOT
+2 ;CLOSES ALL DEVICES
DO ERPT^ACHS
+3 QUIT
+4 ;
HDR ; Print header.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF
+3 IF IOST'["C-"
DO CPI^ACHS
+4 WRITE !,$$REPEAT^XLFSTR("*",79),!,$$C^XBFUNC("CHS DOCUMENTS FOR A SPECIFIC PATIENT",80),!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHST1,!,ACHST2,!,ACHST3,!,?34,$PIECE(^DIC(4,DUZ(2),0),U),!,$$REPEAT^XLFSTR("*",79)
+5 ;ITSC/SET/JVK ACHS*3.1*12
+6 ;W !,"FAC",?7,"DOCUMENT",?17,"DATED",?24,"VENDOR",?47,"TYPE",?52,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!
+7 WRITE !,"DOC #",?7,"ACC #",?24,"DATED",?34,"VENDOR",?55,"TYPE",?61,"STATUS",?69,"AMOUNT",!,$$REPEAT^XLFSTR("-",79),!
+8 QUIT
+9 ;
DISPLAY ; View document selected from the report.
+1 KILL DIR
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to view one of the documents listed"
SET DIR("B")="NO"
+3 DO ^DIR
+4 KILL DIR
+5 IF Y=0
IF ACHSVQIT=0
DO HDR
SET ACHSTOT=ACHSTOT+1
GOTO A
+6 IF Y=0
QUIT
+7 IF ACHSVQIT=1
IF Y=0
IF ACHSPG>1
IF $Y>24
GOTO AGAIN
+8 SET ACHSDVEW=0
+9 Begin DoDot:1
+10 NEW DFN,ACHSDOC
+11 DO ^ACHSAD
+12 QUIT
End DoDot:1
+13 KILL DIR
+14 SET DIR(0)="E"
+15 WRITE !!
+16 DO ^DIR
+17 IF Y=0
GOTO K
+18 IF ACHSVQIT'=1
DO HDR
GOTO A
AGAIN ;
+1 KILL DIR
+2 SET DIR(0)="Y"
SET DIR("A")="View document list again"
SET DIR("B")="NO"
+3 WRITE !!!
+4 DO ^DIR
+5 IF Y=1
SET (ACHSCANC,ACHSVQIT,ACHSTOT,ACHSTOT("$"),ACHSPG)=0
SET ACHSDOC=""
DO HDR
GOTO A
+6 GOTO K
+7 ;
