source: WorldVistAEHR/trunk/r/PAID-PRS/PRSACED.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRSACED ; HISC/REL/FPT-T&A Edits ;12/02/98
2 ;;4.0;PAID;**46,45**;Sep 21, 1995
3PCK R !!,"Select T&L Unit (or ALL): ",X:DTIME G:'$T!("^"[X) KIL S X=$TR(X,"al","AL") I X="ALL" S TLIEN="" G L0
4 K DIC S DIC="^PRST(455.5,",DIC(0)="EMQ" D ^DIC K DIC G:Y<1 PCK S TLIEN=+Y
5L0 W ! K DIC S DIC="^PRST(458,",DIC(0)="AEMQZ" S PPI=$P($G(^PRST(458,0)),U,3) I PPI<1 G KIL
6 S DIC("B")=$P(^PRST(458,PPI,0),U,1) D ^DIC K DIC I +Y<1 G KIL
7 S PPI=+Y
8 W ! K %ZIS S %ZIS="MQ" D ^%ZIS K %ZIS G:POP KIL
9 I $D(IO("Q")) S ZTDESC="T&A EDITS",ZTRTN="Q1^PRSACED" S ZTSAVE("PPI")="",ZTSAVE("TLIEN")="" D ^%ZTLOAD,HOME^%ZIS G KIL
10 U IO D Q1 D ^%ZISC G KIL
11Q1 ;
12 ; Patch 46 12/2/98 TL changed to TLU to correct bug resulting
13 ; from use of TL in code in PRSACED* routines
14 N TLU
15 I $D(ZTQUEUED) S ZTREQ="@"
16 D CODES^PRSACED6 W:$E(IOST,1)="C" @IOF S COUNT=0,HDR=1,YN=""
17 I TLIEN'="" S TLU=$P(^PRST(455.5,TLIEN,0),"^") G EMP
18 S ATL="ATL00"
19TLOOP I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ W !,?10,"*** Output stopped at user's request ***" G KIL
20 S ATL=$O(^PRSPC(ATL)) Q:ATL'?1"ATL".E S TLU=$E(ATL,4,6)
21 S TLIEN="",TLIEN=$O(^PRST(455.5,"B",TLU,TLIEN))
22 D EMP G:YN["^" KIL
23 G TLOOP
24EMP S NAM=""
25EMP1 S NAM=$O(^PRSPC("ATL"_TLU,NAM)) Q:NAM=""
26 S DFN="",YN=""
27EMP2 S DFN=$O(^PRSPC("ATL"_TLU,NAM,DFN)) G:DFN<1 EMP1
28 I '$D(^PRST(458,PPI,"E",DFN,5)) G EMP2
29 I $P(^PRST(458,PPI,"E",DFN,0),"^",2)'="P" G EMP2
30 S COUNT=COUNT+1 D ^PRSACED1 I COUNT#10=1 W "."
31 Q:YN["^" G EMP2
32ERR ;Edit Check Error print out
33 Q:YN["^" G:'HDR!CNT E1 S Y0=$G(^PRSPC(DFN,0)) K ER
34 S SSN=$P(Y0,"^",9) W !!,$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,9)," ",$P(Y0,"^",1),?50,$P(Y0,"^",8),!
35 S CSTR="" F A=13:1:N1 S CCODE=$P(C0,"^",A) I CCODE'="" S CSTR=CSTR_$P(T0," ",A-12)_CCODE_" "
36 F A=1:1:N2 S CCODE=$P(C1,"^",A) I CCODE'="" S CSTR=CSTR_$P(T1," ",A)_CCODE_" "
37 G:CSTR="" E1 S CSTR=$E(CSTR,1,$L(CSTR)-2)
38 I $L(CSTR)<72 W !?5,CSTR,!
39 E S Y=$L(CSTR," ")\2 W !?5,$P(CSTR," ",1,Y),!?5,$P(CSTR," ",Y+1,999),!
40E1 Q:$D(ER(ERR)) S CNT=CNT+1,ER(ERR)="" F LL=0:0 S LL=$O(^PRST(455.1,ERR,"E",LL)) Q:LL<1 W !?5,^(LL,0)
41 I HDR,$Y>(IOSL-5) R:IOST?1"C".E !!,"Press RETURN to Continue. ",YN:DTIME S:'$T YN="^" Q:YN["^" W @IOF
42 Q
43HELP ;
44 K DIC S DIC="^PRST(455.5,",DIC(0)="EMQ",D="B",DZ="??" D DQ^DICQ K DIC,D,DZ
45 Q
46KIL ; P 45--For screen output, hold last screen so menu doesn't
47 ; push info out off screen.
48 N OUT S OUT=$$ASK^PRSLIB00(1)
49 K OUT,%ZIS,A,ATL,C0,C1,CCODE,CNT,COUNT,CSTR,CWK,DAYNO,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,DUT,E,ER,ERR,FLSA,HDR,HMX,I,II,K,LAB,LL,LVG,MX
50 K N1,N2,NAM,NCODE,NN,NOR,PAY,PB,POP,PMP,PPI,SSN,STA,T0,T1,TL,TLIEN,X,X1,Y,YEAR,Y0,YN,YR,Z,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSTOP
51 Q
Note: See TracBrowser for help on using the repository browser.