| 1 | PRSACED6 ; HISC/FPT-T&A Cross-Edits ;11/27/95 10:01
|
|---|
| 2 | ;;4.0;PAID;**6,45,112**;Sep 21, 1995;Build 54
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | CODES ; Set variables T0 and T1 with 8B code list
|
|---|
| 5 | ; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
|
|---|
| 6 | ;
|
|---|
| 7 | S T0="AN SK WD NO AU RT CE CU UN NA NB SP DA SA SB SC OA OB OC OK DB OM RA RB RC HA HB HC HD PT PA ON VC EA EB AL SL WP NP AB RL FA FB FC FD AD AF FE",N1=60
|
|---|
| 8 | S T1="CT CO US NR NS DC TF SE SF SG OE OF OG OS TA OU RE RF RG HL HM HN HO PH PB CL VS EC ED NL DW IN TL LU LN LD TO LA ML CA PC TC CY RR SQ FF DE DF YA DG TG YD YE TB DT YH TD NT NH RS RN ND NU SR SS SD SH",N2=67
|
|---|
| 9 | Q
|
|---|
| 10 | STUB ; parse out 'stub' variables from 8b record
|
|---|
| 11 | S RECORD=^PRST(458,PPI,"E",DFN,5)
|
|---|
| 12 | S STA=$E(RECORD,2,4)
|
|---|
| 13 | S SSN=$E(RECORD,5,13)
|
|---|
| 14 | S NCODE=$E(RECORD,14,16)
|
|---|
| 15 | S DAYNO=$E(RECORD,17,19)
|
|---|
| 16 | S TL=$E(RECORD,22,24)
|
|---|
| 17 | S LVG=$E(RECORD,25)
|
|---|
| 18 | S NOR=$E(RECORD,26,27)
|
|---|
| 19 | S PAY=$E(RECORD,28)
|
|---|
| 20 | S DUT=$E(RECORD,29)
|
|---|
| 21 | S RECORD=$E(RECORD,33,$L(RECORD))
|
|---|
| 22 | S (C0,C1)="",EOR=0
|
|---|
| 23 | Q:RECORD=""
|
|---|
| 24 | TYPE ; parse out type of time from 8b record
|
|---|
| 25 | I EOR=1 K EOR,LOOP,MATCH,RECORD,TYPE,VALUE Q
|
|---|
| 26 | S TYPE=$E(RECORD,1,2)
|
|---|
| 27 | I TYPE="CD" S VALUE=$E(RECORD,3,$L(RECORD)) D CD S EOR=1 G TYPE
|
|---|
| 28 | F LOOP=3:1:$L(RECORD) Q:$E(RECORD,LOOP)?1U
|
|---|
| 29 | S:LOOP=$L(RECORD) EOR=1
|
|---|
| 30 | S VALUE=$S(EOR=1:$E(RECORD,3,LOOP),1:$E(RECORD,3,LOOP-1))
|
|---|
| 31 | S:EOR=0 RECORD=$E(RECORD,LOOP,$L(RECORD))
|
|---|
| 32 | S MATCH=0
|
|---|
| 33 | S Z=$F(T0,TYPE)
|
|---|
| 34 | I Z>2 S $P(C0,"^",(Z/3)+12)=VALUE,MATCH=1
|
|---|
| 35 | G:MATCH=1 TYPE
|
|---|
| 36 | S Z=$F(T1,TYPE)
|
|---|
| 37 | I Z>2 S $P(C1,"^",Z/3)=VALUE
|
|---|
| 38 | G TYPE
|
|---|
| 39 | CD ; calculate/compare cd value
|
|---|
| 40 | S END=$L(C0,"^"),CD=0
|
|---|
| 41 | F LOOP=13:1:END S CD=CD+$P(C0,"^",LOOP)
|
|---|
| 42 | S END=$L(C1,"^")
|
|---|
| 43 | F LOOP=1:1:END S CD=CD+$P(C1,"^",LOOP)
|
|---|
| 44 | I CD'=+VALUE W !,"THE CD VALUE DID NOT ADD UP CORRECTLY FOR ",$P($G(^PRSPC(DFN,0)),"^",1)
|
|---|
| 45 | K CD,END Q
|
|---|
