| 1 | QAOSOCID ;HISC/JES-COMPOSE OCCURRENCE SCREEN IDENTIFICATION NUMBER ;2/4/93 08:39
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | S QACODE=^QA(741,DA,0),QANAME=$P(QACODE,"^",1),QADATE1=$P(QACODE,"^",3)
|
|---|
| 4 | Q:(QANAME="")!(QADATE1="") Q:'$D(^DPT(QANAME,0))
|
|---|
| 5 | S QANAME=$P(^DPT(QANAME,0),"^"),QACODE(0)=0
|
|---|
| 6 | MONTH ; (1) MONTH OF OCCURRENCE (ALPHA A THROUGH L)
|
|---|
| 7 | S QAOSCODE=$C($E(QADATE1,4,5)+64)
|
|---|
| 8 | DAY ; (2) DAY OF OCCURRENCE (ALPHA A THROUGH Z, 27=1,28=2,29=3,30=4,31=5)
|
|---|
| 9 | S QALDAY=$E(QADATE1,6,7)
|
|---|
| 10 | S QAOSCODE=QAOSCODE_$S(QALDAY>26:QALDAY-26,1:$C(QALDAY+64))
|
|---|
| 11 | LNAME ; (3) LAST NAME (FIRST LETTER OF LAST NAME)
|
|---|
| 12 | S QAOSCODE=QAOSCODE_$E(QANAME)
|
|---|
| 13 | FUDGE ; (4-6) FUDGE (LAST 3 DIGITS OF: IEN + LAST 4 DIGITS OF SSN + FUDGE)
|
|---|
| 14 | S QASSN=$E($P(^DPT(+QACODE,0),"^",9),6,9)+DA+QACODE(0)
|
|---|
| 15 | S QASSN="000"_QASSN,QAOSCODE=QAOSCODE_$E(QASSN,$L(QASSN)-2,$L(QASSN))
|
|---|
| 16 | FNAME ; (7) FIRST NAME (FIRST LETTER OF FIRST NAME)
|
|---|
| 17 | S QAOSCODE=QAOSCODE_$E($P(QANAME,",",2))
|
|---|
| 18 | I $D(^QA(741,"E",QAOSCODE)),$O(^QA(741,"E",QAOSCODE,0))'=DA,QACODE(0)'>999 S QACODE(0)=QACODE(0)+1 G MONTH
|
|---|
| 19 | XREF ; EXECUTE SET AND KILL LOGIC
|
|---|
| 20 | S $P(^QA(741,DA,0),"^",4)=QAOSCODE,X=QAOSCODE
|
|---|
| 21 | N QAQAXREF,QAQADICT,QAQAFLD S QAQADICT=741,QAQAFLD=2 D ENSET^QAQAXREF
|
|---|
| 22 | K I,QACODE,QANAME,QADATE1,QALDAY,QASSN,QAOSCODE,X
|
|---|
| 23 | Q
|
|---|
| 24 | KILL ;
|
|---|
| 25 | N QAQAXREF,QAQADICT,QAQAFLD
|
|---|
| 26 | S X=$P(^QA(741,DA,0),"^",4),QAQADICT=741,QAQAFLD=2
|
|---|
| 27 | D ENKILL^QAQAXREF S $P(^QA(741,DA,0),"^",4)=""
|
|---|
| 28 | Q
|
|---|
