QAOSCNV0 ;HISC/DAD-CONVERT TEXT OF FINDINGS ;5/14/93 08:02
;;3.0;Occurrence Screen;;09/14/1993
W !!,"Converting text of findings"
W !,"---------------------------"
F QAOSFNUM=1 D LOOP
K D0,DA,QAOSD0,QAOSFNUM,QAOSOT,QAOSTEXT,QAOSTYPE,QAOSZERO,QAQADICT
K QAQAFLD,X,Y
Q
LOOP ;
S QAOSD0=$O(^QA(741.6,"B",QAOSFNUM,0))
S QAOSZERO=$G(^QA(741.6,+QAOSD0,0))
I (QAOSD0'>0)!(QAOSZERO="") D Q
. W !!,"*** FINDING NUMBER ",QAOSFNUM," NOT FOUND ***"
. Q
S X=$P(QAOSZERO,"^",2),QAQADICT=741.6,QAQAFLD=1,(D0,DA)=QAOSD0
W !!,"Changing finding number: ",QAOSFNUM,!," From: ",X
D ENKILL^QAQAXREF
S QAOSTEXT=$P($T(FIND+QAOSFNUM),";;",2)
S X=$P(QAOSTEXT,"^",2)
W !," To: ",X
S $P(^QA(741.6,QAOSD0,0),"^",2)=X,QAQADICT=741.6,QAQAFLD=1
S (D0,DA)=QAOSD0 D ENSET^QAQAXREF
Q
FIND ;;OLD FINDING TEXT ^ NEW FINDING TEXT
1 ;;OPTIMAL CARE^UCR - USUAL CUSTOMARY & REASONABLE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNV0 896 printed Oct 16, 2024@18:21:52 Page 2
QAOSCNV0 ;HISC/DAD-CONVERT TEXT OF FINDINGS ;5/14/93 08:02
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 WRITE !!,"Converting text of findings"
+3 WRITE !,"---------------------------"
+4 FOR QAOSFNUM=1
DO LOOP
+5 KILL D0,DA,QAOSD0,QAOSFNUM,QAOSOT,QAOSTEXT,QAOSTYPE,QAOSZERO,QAQADICT
+6 KILL QAQAFLD,X,Y
+7 QUIT
LOOP ;
+1 SET QAOSD0=$ORDER(^QA(741.6,"B",QAOSFNUM,0))
+2 SET QAOSZERO=$GET(^QA(741.6,+QAOSD0,0))
+3 IF (QAOSD0'>0)!(QAOSZERO="")
Begin DoDot:1
+4 WRITE !!,"*** FINDING NUMBER ",QAOSFNUM," NOT FOUND ***"
+5 QUIT
End DoDot:1
QUIT
+6 SET X=$PIECE(QAOSZERO,"^",2)
SET QAQADICT=741.6
SET QAQAFLD=1
SET (D0,DA)=QAOSD0
+7 WRITE !!,"Changing finding number: ",QAOSFNUM,!," From: ",X
+8 DO ENKILL^QAQAXREF
+9 SET QAOSTEXT=$PIECE($TEXT(FIND+QAOSFNUM),";;",2)
+10 SET X=$PIECE(QAOSTEXT,"^",2)
+11 WRITE !," To: ",X
+12 SET $PIECE(^QA(741.6,QAOSD0,0),"^",2)=X
SET QAQADICT=741.6
SET QAQAFLD=1
+13 SET (D0,DA)=QAOSD0
DO ENSET^QAQAXREF
+14 QUIT
FIND ;;OLD FINDING TEXT ^ NEW FINDING TEXT
1 ;;OPTIMAL CARE^UCR - USUAL CUSTOMARY & REASONABLE
