QAOSCNV6 ;HISC/DAD-DELETE DESCRIPTIONS ;7/19/93  12:45
 ;;3.0;Occurrence Screen;;09/14/1993
 ;;
 W !!,"Cleaning up OPTION and FIELD descriptions"
 W !,"-----------------------------------------"
 W !!,"Working"
 F QAOSLINE=1:1 S QAOSDATA=$P($T(DATA+QAOSLINE),";;",2) Q:QAOSDATA=""  D
 . W "."
 . I QAOSDATA'>0 D OPTN Q
 . E  D FLDS Q
 K QAOSLINE,QAOSDATA,QAOSOPT,QAOSD0,QAOSDD,QAOSFLD,DIE,DA,DR
 Q
OPTN ; *** Delete OPTION file descriptions
 S QAOSOPT=QAOSDATA,QAOSD0=0
 F  S QAOSD0=$O(^DIC(19,"B",QAOSOPT,QAOSD0)) Q:QAOSD0'>0  D
 . Q:$P($G(^DIC(19,QAOSD0,0)),"^")'=QAOSOPT
 . S DIE="^DIC(19,",DA=QAOSD0,DR="3.5///@"
 . D ^DIE
 . Q
 Q
FLDS ; *** Delete FIELD descriptions
 S QAOSDD=$P(QAOSDATA,"^"),QAOSFLD=$P(QAOSDATA,"^",2)
 Q:$O(^DD(QAOSDD,QAOSFLD,21,0))'>0
 S DIE="^DD("_QAOSDD_",",DA=QAOSFLD,DR="21///@"
 D ^DIE
 Q
DATA ;; Option_Name   OR   DD_Number ^ Field_Number
 ;;QAOS GENERATE EWS BULLETIN
 ;;QAOS RPT REVIEW SUMMARY
 ;;741^19
 ;;741^22
 ;;741^28
 ;;741.01^4
 ;;741.01^9
 ;;741.6^.01
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNV6   1031     printed  Sep 23, 2025@19:57:38                                                                                                                                                                                                    Page 2
QAOSCNV6  ;HISC/DAD-DELETE DESCRIPTIONS ;7/19/93  12:45
 +1       ;;3.0;Occurrence Screen;;09/14/1993
 +2       ;;
 +3        WRITE !!,"Cleaning up OPTION and FIELD descriptions"
 +4        WRITE !,"-----------------------------------------"
 +5        WRITE !!,"Working"
 +6        FOR QAOSLINE=1:1
               SET QAOSDATA=$PIECE($TEXT(DATA+QAOSLINE),";;",2)
               if QAOSDATA=""
                   QUIT 
               Begin DoDot:1
 +7                WRITE "."
 +8                IF QAOSDATA'>0
                       DO OPTN
                       QUIT 
 +9               IF '$TEST
                       DO FLDS
                       QUIT 
               End DoDot:1
 +10       KILL QAOSLINE,QAOSDATA,QAOSOPT,QAOSD0,QAOSDD,QAOSFLD,DIE,DA,DR
 +11       QUIT 
OPTN      ; *** Delete OPTION file descriptions
 +1        SET QAOSOPT=QAOSDATA
           SET QAOSD0=0
 +2        FOR 
               SET QAOSD0=$ORDER(^DIC(19,"B",QAOSOPT,QAOSD0))
               if QAOSD0'>0
                   QUIT 
               Begin DoDot:1
 +3                if $PIECE($GET(^DIC(19,QAOSD0,0)),"^")'=QAOSOPT
                       QUIT 
 +4                SET DIE="^DIC(19,"
                   SET DA=QAOSD0
                   SET DR="3.5///@"
 +5                DO ^DIE
 +6                QUIT 
               End DoDot:1
 +7        QUIT 
FLDS      ; *** Delete FIELD descriptions
 +1        SET QAOSDD=$PIECE(QAOSDATA,"^")
           SET QAOSFLD=$PIECE(QAOSDATA,"^",2)
 +2        if $ORDER(^DD(QAOSDD,QAOSFLD,21,0))'>0
               QUIT 
 +3        SET DIE="^DD("_QAOSDD_","
           SET DA=QAOSFLD
           SET DR="21///@"
 +4        DO ^DIE
 +5        QUIT 
DATA      ;; Option_Name   OR   DD_Number ^ Field_Number
 +1       ;;QAOS GENERATE EWS BULLETIN
 +2       ;;QAOS RPT REVIEW SUMMARY
 +3       ;;741^19
 +4       ;;741^22
 +5       ;;741^28
 +6       ;;741.01^4
 +7       ;;741.01^9
 +8       ;;741.6^.01