| 1 | QAOSCNV0 ;HISC/DAD-CONVERT TEXT OF FINDINGS ;5/14/93 08:02
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | W !!,"Converting text of findings"
|
|---|
| 4 | W !,"---------------------------"
|
|---|
| 5 | F QAOSFNUM=1 D LOOP
|
|---|
| 6 | K D0,DA,QAOSD0,QAOSFNUM,QAOSOT,QAOSTEXT,QAOSTYPE,QAOSZERO,QAQADICT
|
|---|
| 7 | K QAQAFLD,X,Y
|
|---|
| 8 | Q
|
|---|
| 9 | LOOP ;
|
|---|
| 10 | S QAOSD0=$O(^QA(741.6,"B",QAOSFNUM,0))
|
|---|
| 11 | S QAOSZERO=$G(^QA(741.6,+QAOSD0,0))
|
|---|
| 12 | I (QAOSD0'>0)!(QAOSZERO="") D Q
|
|---|
| 13 | . W !!,"*** FINDING NUMBER ",QAOSFNUM," NOT FOUND ***"
|
|---|
| 14 | . Q
|
|---|
| 15 | S X=$P(QAOSZERO,"^",2),QAQADICT=741.6,QAQAFLD=1,(D0,DA)=QAOSD0
|
|---|
| 16 | W !!,"Changing finding number: ",QAOSFNUM,!," From: ",X
|
|---|
| 17 | D ENKILL^QAQAXREF
|
|---|
| 18 | S QAOSTEXT=$P($T(FIND+QAOSFNUM),";;",2)
|
|---|
| 19 | S X=$P(QAOSTEXT,"^",2)
|
|---|
| 20 | W !," To: ",X
|
|---|
| 21 | S $P(^QA(741.6,QAOSD0,0),"^",2)=X,QAQADICT=741.6,QAQAFLD=1
|
|---|
| 22 | S (D0,DA)=QAOSD0 D ENSET^QAQAXREF
|
|---|
| 23 | Q
|
|---|
| 24 | FIND ;;OLD FINDING TEXT ^ NEW FINDING TEXT
|
|---|
| 25 | 1 ;;OPTIMAL CARE^UCR - USUAL CUSTOMARY & REASONABLE
|
|---|
