QAOSCNV0.m

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 ---QAOSCNV0   896     printed  Apr 09, 2024@21:23:04                                                                                                                                                                                                     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