QAOSCNV6.m

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 ---QAOSCNV6   1031     printed  Mar 13, 2025@21:26:18                                                                                                                                                                                                    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