- ACHSDAR1 ; IHS/ITSC/TPF/PMF - PATIENT ALTERNATE RESOURCE LETTER (2/2) ;
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
- ;
- START ;EP
- ;
- S ACHSQUIT=0
- U IO
- D BM^ACHS ;SET BOTTOM MARGIN TO ACHDBM
- S ACHSBM=ACHSBM-4
- S ACHDONE=""
- F I=1:1:4 W "*** OFFICE COPY *** "
- W !!!
- S ACHSPG=1
- S DIWL=5
- S DIWR=$S($G(IOM):IOM,1:75)
- S DIWF="W"
- DOC ;
- D HEADER^ACHSDNL2
- W !!!?DIWL-1,$$FMTE^XLFDT($$DN^ACHS(0,2)) ;'DATE DENIAL ISSUED'
- S ACHDOC="Document number: "_$$DN^ACHS(0,1) ;DENIAL NUMBER'
- W ?(DIWR-$L(ACHDOC)),ACHDOC,!!
- ;
- ;IF 'PATIENT REGISTERED?" GET NON-REGISTERED PATIENT DATA
- I $$DN^ACHS(0,6)'="Y" S ACHDPAT=$G(^ACHSDEN(DUZ(2),"D",ACHSA,10)),ACHDNAMP=$P($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U),",",2)_" "_$P($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U),",") G DOC1
- ;
- ;OTHER WISE GET THE PATIENT DATA FROM PATIENT FILE
- S ACHDPAT=$G(^DPT($$DN^ACHS(0,7),.11))
- S ACHDPAT=U_$P(ACHDPAT,U)_" "_$P(ACHDPAT,U,2)_" "_$P(ACHDPAT,U,3)_U_$P(ACHDPAT,U,4)_U_$P(ACHDPAT,U,5)_U_$P(ACHDPAT,U,6)
- S ACHDPAT=$P($G(^DPT($$DN^ACHS(0,7),0)),U)_ACHDPAT
- S ACHDNAMP=$P($P(ACHDPAT,U),",",2)_" "_$P($P(ACHDPAT,U),",",1)
- DOC1 ;
- W !!?DIWL-1,ACHDNAMP,!?DIWL-1,$P(ACHDPAT,U,2),!?DIWL-1,$P(ACHDPAT,U,3)_", "_$P($G(^DIC(5,$P(ACHDPAT,U,4),0)),U,2)_" "_$P(ACHDPAT,U,5),!
- W !!?DIWL-1,"Re: Patient: ",$P($P(ACHDPAT,U),",",2)_" "_$P($P(ACHDPAT,U),",")
- W !?DIWL+8,"Date of service: ",$$FMTE^XLFDT($$DN^ACHS(0,4))
- ;
- ;GET PROVIDER INFORMATION
- D PROV^ACHSDAR5 Q:$G(ACHSQUIT)
- ;
- ;GET ALTERNATE RESOURCES INFORMATION
- D ALTR^ACHSDAR5 Q:$G(ACHSQUIT)
- ;
- ;GET 'OTHER IHS RESOURCES'
- D IHSRES^ACHSDAR5 Q:$G(ACHSQUIT)
- ;
- W !!?DIWL-1,"Dear ",$P($P(ACHDPAT,U),",",2)_" "_$P($P(ACHDPAT,U),",")_",",!!
- ; --- Alternate Resource Text (Top)
- S ACHDX=0
- F S ACHDX=$O(^ACHSDENR(DUZ(2),10,ACHDX)) Q:'ACHDX D Q:$G(ACHSQUIT)
- .S X=$G(^ACHSDENR(DUZ(2),10,ACHDX,0))
- .D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- D ^DIWW
- ;
- ;DO FORM ?????
- ;S DIWF="I5C60W",ACHDOP=0
- ;F S ACHDOP=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP)) G NDOC:'ACHDOP D OPT
- ;
- OPT ; --- Alternate Resource Options
- ;S ACHDX=0
- ;F S ACHDX=$O(^ACHSDENR(DUZ(2),12,ACHDOP,1,ACHDX)) Q:'ACHDX D Q:$G(ACHSQUIT)
- ;.S X=$G(^ACHSDENR(DUZ(2),12,ACHDOP,1,ACHDX,0)) D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- ;D ^DIWW
- ;
- ;D OPTXT:$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,0)),U)=4
- ;S:$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,0)),U)=2 ACHDNDOC=""
- ;Q
- ;
- ;WRITE OPTION TEXT
- OPTXT ;
- ;W !
- ;S ACHDZ=0
- ;F S ACHDZ=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,1,ACHDZ)) Q:'ACHDZ D Q:$G(ACHSQUIT)
- ;.S X=$G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,1,ACHDZ,0))
- ;.D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- ;D ^DIWW
- ;Q
- ;
- ;NO ALTERNATE RESOURCES DOCUMENTED
- NDOC ;
- I $D(ACHDNDOC) D Q:$G(ACHSQUIT) D ^DIWW S DIWL=5,DIWR=$S($G(IOM):IOM,1:75)
- . W !!?9,"Documentation Needed For Appeal:",!!
- . S ACHD=0,DIWL=10,DIWR=$S($G(IOM):(IOM-5),1:70)
- . F S ACHD=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,ACHD)) Q:+ACHD=0 D Q:$G(ACHSQUIT)
- .S X=$G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,ACHD,0))
- .D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- ;
- BOTTXT ;
- D PG:$Y>ACHSBM
- Q:$G(ACHSQUIT)
- W !!
- K DIWF
- S DIWL=5,DIWR=$S($G(IOM):IOM,1:75)
- ; --- Alternate Resource Text (Bottom)
- S X=^ACHSDENR(DUZ(2),0),ACHSDBCN=$P(X,U,12),ACHSDBCP=$P(X,U,13) ;ACHS*3.1*18
- S ACHDX=0
- F S ACHDX=$O(^ACHSDENR(DUZ(2),11,ACHDX)) Q:'ACHDX D Q:$G(ACHSQUIT)
- .;S X=$G(^ACHSDENR(DUZ(2),11,ACHDX,0)) D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT) ;ACHS*3.1*18
- .S X=$G(^ACHSDENR(DUZ(2),11,ACHDX,0))
- .I X["ACHSDBCN" S X=$P(X,"ACHSDBCN",1)_ACHSDBCN_$P(X,"ACHSDBCN",2)
- .I X["ACHSDBCP" S X=$P(X,"ACHSDBCP",1)_ACHSDBCP_$P(X,"ACHSDBCP",2)
- .D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- D ^DIWW
- ;
- SUD ; --- SUD Signature Block
- D PG:$Y>(ACHSBM-15)
- Q:$G(ACHSQUIT)
- W !!?30,"Sincerely yours,",!!!!?30,$$SUD^ACHS(1)
- I $L($$SUD^ACHS(7)) W !?30,$$SUD^ACHS(7)
- W !?30,$$SUD^ACHS(2),!?30,$$SUD^ACHS(3),", ",$P($G(^DIC(5,$$SUD^ACHS(4),0)),U,2)," ",$$SUD^ACHS(5),!?30,"Telephone: ",$$SUD^ACHS(6)
- CMT ; --- Office Comments
- G:'$D(ACHDONE) END
- W !!!," Denial Number: ",$$DN^ACHS(0,1)
- ;
- W !," Chart Number: "
- ;
- ;IS THE 'PATIENT REGISTERED?'
- I $$DN^ACHS(0,6)="Y" D
- .;IF REGISTERED IS THERE A 'REGISTERED PATIENT' PTR?
- .W:'$$DN^ACHS(0,7) !!,"CANNOT FIND A PATIENT POINTER FOR A APPARENTLY REGISTERED PATIENT WITHIN THE 'CHS DENIAL DATA' FILE!!",!,"REPORT THIS TO YOUR SITE MANAGER IMMEDIATELY!",!,"DOCUMENT IEN: ",ACHSA
- .Q:'$$DN^ACHS(0,6)
- .W $P($G(^AUPNPAT($$DN^ACHS(0,7),41,DUZ(2),0)),U,2)
- W $S($L($$DN^ACHS(10,6)):$$DN^ACHS(10,6),1:"No Chart Number Available")
- ;
- I $$DN^ACHS(850,1)'="Y" W !,"No Receipt Information Available",! G CMT1
- W !,"Method of receipt: ",$$DN^ACHS(850,2)
- W !," Date of receipt: ",$$FMTE^XLFDT($$DN^ACHS(850,3))
- W !," Received by: ",$$DN^ACHS(850,4)
- CMT1 ;
- G:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)) END
- W !,"CHS Office Comments: ",!
- S ACHD=0
- F S ACHD=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,2,ACHD)) Q:'ACHD D Q:$G(ACHSQUIT)
- .S X=$G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,2,ACHD,0))
- .D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- D ^DIWW
- END ;EP
- W !!!
- I $D(ACHDONE) D G DOC
- . F I=1:1:4 W "*** OFFICE COPY *** "
- . K ACHDONE
- . W @IOF
- . S ACHSPG=1,DIWL=5,DIWR=$S($G(IOM):IOM,1:75),DIWF="W"
- ;
- END1 ;EP from ACHSDAR
- I IO=IO(0) D RTRN^ACHS
- W @IOF
- K ACHSA,ACHDALRS,ACHDOCT,ACHDLKER,DIR,ACHDA,ACHDALRS,ACHD,ACHDX,ACHDI,ACHDQ,ACHDOP,ACHDPAT,ACHDNDOC
- D ^%ZISC
- Q
- ;
- PG ; --- Pagination for the Alternate Resource Letter.
- Q:$G(ACHSQUIT)!$D(DUOUT)!$D(DTOUT)
- D RTRN^ACHS
- S ACHSPG=ACHSPG+1
- W @IOF,!!!?DIWL-1,ACHDNAMP,?($S($G(IOM):IOM,1:75)-$L(ACHDOC)),ACHDOC,!?($S($G(IOM):IOM,1:75)-$L("Page "_ACHSPG)),"Page ",ACHSPG,!!
- Q
- ;
- ACHSDAR1 ; IHS/ITSC/TPF/PMF - PATIENT ALTERNATE RESOURCE LETTER (2/2) ;
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
- +2 ;
- START ;EP
- +1 ;
- +2 SET ACHSQUIT=0
- +3 USE IO
- +4 ;SET BOTTOM MARGIN TO ACHDBM
- DO BM^ACHS
- +5 SET ACHSBM=ACHSBM-4
- +6 SET ACHDONE=""
- +7 FOR I=1:1:4
- WRITE "*** OFFICE COPY *** "
- +8 WRITE !!!
- +9 SET ACHSPG=1
- +10 SET DIWL=5
- +11 SET DIWR=$SELECT($GET(IOM):IOM,1:75)
- +12 SET DIWF="W"
- DOC ;
- +1 DO HEADER^ACHSDNL2
- +2 ;'DATE DENIAL ISSUED'
- WRITE !!!?DIWL-1,$$FMTE^XLFDT($$DN^ACHS(0,2))
- +3 ;DENIAL NUMBER'
- SET ACHDOC="Document number: "_$$DN^ACHS(0,1)
- +4 WRITE ?(DIWR-$LENGTH(ACHDOC)),ACHDOC,!!
- +5 ;
- +6 ;IF 'PATIENT REGISTERED?" GET NON-REGISTERED PATIENT DATA
- +7 IF $$DN^ACHS(0,6)'="Y"
- SET ACHDPAT=$GET(^ACHSDEN(DUZ(2),"D",ACHSA,10))
- SET ACHDNAMP=$PIECE($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U),",",2)_" "_$PIECE($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,10)),U),",")
- GOTO DOC1
- +8 ;
- +9 ;OTHER WISE GET THE PATIENT DATA FROM PATIENT FILE
- +10 SET ACHDPAT=$GET(^DPT($$DN^ACHS(0,7),.11))
- +11 SET ACHDPAT=U_$PIECE(ACHDPAT,U)_" "_$PIECE(ACHDPAT,U,2)_" "_$PIECE(ACHDPAT,U,3)_U_$PIECE(ACHDPAT,U,4)_U_$PIECE(ACHDPAT,U,5)_U_$PIECE(ACHDPAT,U,6)
- +12 SET ACHDPAT=$PIECE($GET(^DPT($$DN^ACHS(0,7),0)),U)_ACHDPAT
- +13 SET ACHDNAMP=$PIECE($PIECE(ACHDPAT,U),",",2)_" "_$PIECE($PIECE(ACHDPAT,U),",",1)
- DOC1 ;
- +1 WRITE !!?DIWL-1,ACHDNAMP,!?DIWL-1,$PIECE(ACHDPAT,U,2),!?DIWL-1,$PIECE(ACHDPAT,U,3)_", "_$PIECE($GET(^DIC(5,$PIECE(ACHDPAT,U,4),0)),U,2)_" "_$PIECE(ACHDPAT,U,5),!
- +2 WRITE !!?DIWL-1,"Re: Patient: ",$PIECE($PIECE(ACHDPAT,U),",",2)_" "_$PIECE($PIECE(ACHDPAT,U),",")
- +3 WRITE !?DIWL+8,"Date of service: ",$$FMTE^XLFDT($$DN^ACHS(0,4))
- +4 ;
- +5 ;GET PROVIDER INFORMATION
- +6 DO PROV^ACHSDAR5
- IF $GET(ACHSQUIT)
- QUIT
- +7 ;
- +8 ;GET ALTERNATE RESOURCES INFORMATION
- +9 DO ALTR^ACHSDAR5
- IF $GET(ACHSQUIT)
- QUIT
- +10 ;
- +11 ;GET 'OTHER IHS RESOURCES'
- +12 DO IHSRES^ACHSDAR5
- IF $GET(ACHSQUIT)
- QUIT
- +13 ;
- +14 WRITE !!?DIWL-1,"Dear ",$PIECE($PIECE(ACHDPAT,U),",",2)_" "_$PIECE($PIECE(ACHDPAT,U),",")_",",!!
- +15 ; --- Alternate Resource Text (Top)
- +16 SET ACHDX=0
- +17 FOR
- SET ACHDX=$ORDER(^ACHSDENR(DUZ(2),10,ACHDX))
- IF 'ACHDX
- QUIT
- Begin DoDot:1
- +18 SET X=$GET(^ACHSDENR(DUZ(2),10,ACHDX,0))
- +19 DO ^DIWP
- IF $Y>ACHSBM
- DO PG
- IF $GET(ACHSQUIT)
- QUIT
- End DoDot:1
- IF $GET(ACHSQUIT)
- QUIT
- +20 DO ^DIWW
- +21 ;
- +22 ;DO FORM ?????
- +23 ;S DIWF="I5C60W",ACHDOP=0
- +24 ;F S ACHDOP=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP)) G NDOC:'ACHDOP D OPT
- +25 ;
- OPT ; --- Alternate Resource Options
- +1 ;S ACHDX=0
- +2 ;F S ACHDX=$O(^ACHSDENR(DUZ(2),12,ACHDOP,1,ACHDX)) Q:'ACHDX D Q:$G(ACHSQUIT)
- +3 ;.S X=$G(^ACHSDENR(DUZ(2),12,ACHDOP,1,ACHDX,0)) D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- +4 ;D ^DIWW
- +5 ;
- +6 ;D OPTXT:$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,0)),U)=4
- +7 ;S:$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,0)),U)=2 ACHDNDOC=""
- +8 ;Q
- +9 ;
- +10 ;WRITE OPTION TEXT
- OPTXT ;
- +1 ;W !
- +2 ;S ACHDZ=0
- +3 ;F S ACHDZ=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,1,ACHDZ)) Q:'ACHDZ D Q:$G(ACHSQUIT)
- +4 ;.S X=$G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,3,ACHDOP,1,ACHDZ,0))
- +5 ;.D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT)
- +6 ;D ^DIWW
- +7 ;Q
- +8 ;
- +9 ;NO ALTERNATE RESOURCES DOCUMENTED
- NDOC ;
- +1 IF $DATA(ACHDNDOC)
- Begin DoDot:1
- +2 WRITE !!?9,"Documentation Needed For Appeal:",!!
- +3 SET ACHD=0
- SET DIWL=10
- SET DIWR=$SELECT($GET(IOM):(IOM-5),1:70)
- +4 FOR
- SET ACHD=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,ACHD))
- IF +ACHD=0
- QUIT
- Begin DoDot:2
- End DoDot:2
- IF $GET(ACHSQUIT)
- QUIT
- +5 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,ACHD,0))
- +6 DO ^DIWP
- IF $Y>ACHSBM
- DO PG
- IF $GET(ACHSQUIT)
- QUIT
- End DoDot:1
- IF $GET(ACHSQUIT)
- QUIT
- DO ^DIWW
- SET DIWL=5
- SET DIWR=$SELECT($GET(IOM):IOM,1:75)
- +7 ;
- BOTTXT ;
- +1 IF $Y>ACHSBM
- DO PG
- +2 IF $GET(ACHSQUIT)
- QUIT
- +3 WRITE !!
- +4 KILL DIWF
- +5 SET DIWL=5
- SET DIWR=$SELECT($GET(IOM):IOM,1:75)
- +6 ; --- Alternate Resource Text (Bottom)
- +7 ;ACHS*3.1*18
- SET X=^ACHSDENR(DUZ(2),0)
- SET ACHSDBCN=$PIECE(X,U,12)
- SET ACHSDBCP=$PIECE(X,U,13)
- +8 SET ACHDX=0
- +9 FOR
- SET ACHDX=$ORDER(^ACHSDENR(DUZ(2),11,ACHDX))
- IF 'ACHDX
- QUIT
- Begin DoDot:1
- +10 ;S X=$G(^ACHSDENR(DUZ(2),11,ACHDX,0)) D ^DIWP,PG:$Y>ACHSBM Q:$G(ACHSQUIT) ;ACHS*3.1*18
- +11 SET X=$GET(^ACHSDENR(DUZ(2),11,ACHDX,0))
- +12 IF X["ACHSDBCN"
- SET X=$PIECE(X,"ACHSDBCN",1)_ACHSDBCN_$PIECE(X,"ACHSDBCN",2)
- +13 IF X["ACHSDBCP"
- SET X=$PIECE(X,"ACHSDBCP",1)_ACHSDBCP_$PIECE(X,"ACHSDBCP",2)
- +14 DO ^DIWP
- IF $Y>ACHSBM
- DO PG
- IF $GET(ACHSQUIT)
- QUIT
- End DoDot:1
- IF $GET(ACHSQUIT)
- QUIT
- +15 DO ^DIWW
- +16 ;
- SUD ; --- SUD Signature Block
- +1 IF $Y>(ACHSBM-15)
- DO PG
- +2 IF $GET(ACHSQUIT)
- QUIT
- +3 WRITE !!?30,"Sincerely yours,",!!!!?30,$$SUD^ACHS(1)
- +4 IF $LENGTH($$SUD^ACHS(7))
- WRITE !?30,$$SUD^ACHS(7)
- +5 WRITE !?30,$$SUD^ACHS(2),!?30,$$SUD^ACHS(3),", ",$PIECE($GET(^DIC(5,$$SUD^ACHS(4),0)),U,2)," ",$$SUD^ACHS(5),!?30,"Telephone: ",$$SUD^ACHS(6)
- CMT ; --- Office Comments
- +1 IF '$DATA(ACHDONE)
- GOTO END
- +2 WRITE !!!," Denial Number: ",$$DN^ACHS(0,1)
- +3 ;
- +4 WRITE !," Chart Number: "
- +5 ;
- +6 ;IS THE 'PATIENT REGISTERED?'
- +7 IF $$DN^ACHS(0,6)="Y"
- Begin DoDot:1
- +8 ;IF REGISTERED IS THERE A 'REGISTERED PATIENT' PTR?
- +9 IF '$$DN^ACHS(0,7)
- WRITE !!,"CANNOT FIND A PATIENT POINTER FOR A APPARENTLY REGISTERED PATIENT WITHIN THE 'CHS DENIAL DATA' FILE!!",!,"REPORT THIS TO YOUR SITE MANAGER IMMEDIATELY!",!,"DOCUMENT IEN: ",ACHSA
- +10 IF '$$DN^ACHS(0,6)
- QUIT
- +11 WRITE $PIECE($GET(^AUPNPAT($$DN^ACHS(0,7),41,DUZ(2),0)),U,2)
- End DoDot:1
- +12 WRITE $SELECT($LENGTH($$DN^ACHS(10,6)):$$DN^ACHS(10,6),1:"No Chart Number Available")
- +13 ;
- +14 IF $$DN^ACHS(850,1)'="Y"
- WRITE !,"No Receipt Information Available",!
- GOTO CMT1
- +15 WRITE !,"Method of receipt: ",$$DN^ACHS(850,2)
- +16 WRITE !," Date of receipt: ",$$FMTE^XLFDT($$DN^ACHS(850,3))
- +17 WRITE !," Received by: ",$$DN^ACHS(850,4)
- CMT1 ;
- +1 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0))
- GOTO END
- +2 WRITE !,"CHS Office Comments: ",!
- +3 SET ACHD=0
- +4 FOR
- SET ACHD=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,2,ACHD))
- IF 'ACHD
- QUIT
- Begin DoDot:1
- +5 SET X=$GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,2,ACHD,0))
- +6 DO ^DIWP
- IF $Y>ACHSBM
- DO PG
- IF $GET(ACHSQUIT)
- QUIT
- End DoDot:1
- IF $GET(ACHSQUIT)
- QUIT
- +7 DO ^DIWW
- END ;EP
- +1 WRITE !!!
- +2 IF $DATA(ACHDONE)
- Begin DoDot:1
- +3 FOR I=1:1:4
- WRITE "*** OFFICE COPY *** "
- +4 KILL ACHDONE
- +5 WRITE @IOF
- +6 SET ACHSPG=1
- SET DIWL=5
- SET DIWR=$SELECT($GET(IOM):IOM,1:75)
- SET DIWF="W"
- End DoDot:1
- GOTO DOC
- +7 ;
- END1 ;EP from ACHSDAR
- +1 IF IO=IO(0)
- DO RTRN^ACHS
- +2 WRITE @IOF
- +3 KILL ACHSA,ACHDALRS,ACHDOCT,ACHDLKER,DIR,ACHDA,ACHDALRS,ACHD,ACHDX,ACHDI,ACHDQ,ACHDOP,ACHDPAT,ACHDNDOC
- +4 DO ^%ZISC
- +5 QUIT
- +6 ;
- PG ; --- Pagination for the Alternate Resource Letter.
- +1 IF $GET(ACHSQUIT)!$DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +2 DO RTRN^ACHS
- +3 SET ACHSPG=ACHSPG+1
- +4 WRITE @IOF,!!!?DIWL-1,ACHDNAMP,?($SELECT($GET(IOM):IOM,1:75)-$LENGTH(ACHDOC)),ACHDOC,!?($SELECT($GET(IOM):IOM,1:75)-$LENGTH("Page "_ACHSPG)),"Page ",ACHSPG,!!
- +5 QUIT
- +6 ;
