Routine: QAOSCNV1

QAOSCNV1 ;HISC/DAD-DELETE OLD OCCURRENCE SCREEN FILES/FIELDS ;8/10/93  10:12

 ;;3.0;Occurrence Screen;;09/14/1993

 S QAOSDD(0)=0 F QAOSDD=513.73:.01:513.79 S X=$P($G(^DIC(QAOSDD,0)),"^"),QAOSDD(QAOSDD)=(X]"")_"^"_QAOSDD_"^"_$S(X]"":X,1:"") S:X]"" QAOSDD(0)=1

 S QAOSFLD(0)=0 F QAOFFSET=1:1 S QAOSFLD=$P($T(FLDS+QAOFFSET),";",3) Q:QAOSFLD=""  S X=$G(^DD(513.72,+QAOSFLD,0)),QAOSFLD(+QAOSFLD)=(X]"")_"^"_$P(X,"^")_"^"_$P(QAOSFLD,"^",2) S:X]"" QAOSFLD(0)=1

 G:(QAOSDD(0)'>0)&(QAOSFLD(0)'>0) 740

 W !!,"Delete version 1.01 Occurrence Screen files/fields"

 W !,"--------------------------------------------------",!

 D SHOWFILE:QAOSDD(0),SHOWFLDS:QAOSFLD(0)

ASKDEL ;

 W !!,"Are you sure you want to continue" S %=2 D YN^DICN

 I (%=-1)!(%=2) D  G EXIT

 . W *7,!!!?24,"*** EXITING THE INIT PROCESS ***"

 . W !!?12,"Occurrence Screen V3.0 may not be installed until after"

 . W !?14,"the successful completion of the pre-init routine !!",*7

 . K DIFQ

. Q

 I '% D  G ASKDEL

 . W !!?5,"Answer Y(es) to delete the items displayed,"

 . W !?5,"and continue with the installation."

 . W !!?5,"Answering N(o) will leave the files untouched"

 . W !?5,"and abort the installation."

 . D SHOWFILE:QAOSDD(0),SHOWFLDS:QAOSFLD(0)

. Q

 D DELFILE:QAOSDD(0),DELFLDS:QAOSFLD(0)

740 ;

 I $D(^DD(740,741.97,0))[0,$D(^DD(740,741.98,0))[0 G 741

 W !!,"Delete OS/2.5 temporary conversion fields from file #740"

 W !,"--------------------------------------------------------",!

 W !?5,"Field: 741.97 - ",$P($G(^DD(740,741.97,0)),"^")

 S DIK="^DD(740,",DA=741.97,DA(1)=740 D ^DIK

 W !?5,"Field: 741.98 - ",$P($G(^DD(740,741.98,0)),"^")

 S DIK="^DD(740,",DA=741.98,DA(1)=740 D ^DIK K ^QA(740,1,"QAO")

741 ;

 I $D(^QA(741,"AF"))[0 G 107

 W !!,"Kill the 'AC', 'AF' and 'AE' cross references in file #741"

 W !,"----------------------------------------------------------",!

 K DA,DIK S DIK="^DD(741.01,9,1,",DA(2)=741.01,DA(1)=9,DA=1

 W !?5,"Xref: 'AC'" D ^DIK W " killed"

 K DA,DIK S DIK="^DD(741,2,1,",DA(2)=741,DA(1)=2,DA=1

 W !?5,"Xref: 'AF'" D ^DIK K ^QA(741,"AF") W " killed"

 K DA,DIK S DIK="^DD(741,14,1,",DA(2)=741,DA(1)=14,DA=3

 W !?5,"Xref: 'AE'" D ^DIK W " killed"

107 ;

 I $D(^QA(741.1,107,0))[0 G EXIT

 W !!,"Convert screen 107 to return to O.R. within 7 days"

 W !,"--------------------------------------------------",!

 S QA="UNPLANNED RETURN TO OR IN SAME ADMISSION, OR WITHIN 7 DAYS OF OPERATION"

 W !?5,QA

 K DA,DIE,DR S DIE="^QA(741.1,",DA=107,DR="2///"_QA

 D ^DIE

EXIT ;

 K %,DA,DIC,DIK,DIU,QAOFFSET,QAOSDD,QAOSFLD,X,Y

SHOWFILE ;

 W !!,"The following files are about to be deleted:",!

 F QAOSDD=513.73:.01:513.79 W:QAOSDD(QAOSDD) !?5,QAOSDD,?14,$P(QAOSDD(QAOSDD),"^",3)

DELFILE ;

 W !!,"Deleting files:",!

 F QAOSDD=513.73:.01:513.79 D

 . Q:QAOSDD(QAOSDD)'>0

 . W !?5,QAOSDD,?14,$P(QAOSDD(QAOSDD),"^",3)

 . S DIU=QAOSDD,DIU(0)="DT" D EN^DIU2

. Q

SHOWFLDS ;

 W !!,"The following fields in the PATIENT QA EVENT file (#513.72)",!,"are about to be deleted:",!

 F QAOSFLD=0:0 S QAOSFLD=$O(QAOSFLD(QAOSFLD)) Q:QAOSFLD'>0  D

 . S X=QAOSFLD(QAOSFLD)

 . I X W !?5,QAOSFLD,?14,$P(X,"^",2),$S($P(X,"^",3)="M":"   (Mult)",1:"")

. Q

DELFLDS ;

 W !!,"Deleting fields in the PATIENT QA EVENT file (#513.72):",!

 F QAOSFLD=0:0 S QAOSFLD=$O(QAOSFLD(QAOSFLD)) Q:QAOSFLD'>0  D

 . S X=QAOSFLD(QAOSFLD) Q:X'>0

 . W !?5,QAOSFLD,?14,$P(X,"^",2),$S($P(X,"^",3)="M":"   (Mult)",1:"")

 . I $P(X,"^",3)="M" D

 .. S DIU=+$P(^DD(513.72,QAOSFLD,0),"^",2),DIU(0)="DS" D EN^DIU2

 .. Q

 . E  D

 .. S DIK="^DD(513.72,",DA=QAOSFLD,DA(1)=513.72 D ^DIK

 .. Q

. Q

FLDS ;;FIELDS IN 513.72 TO BE DELETED ^ 'M' IF FIELD IS MULTIPLE

;;9

 ;;10

 ;;12

 ;;13

 ;;14

 ;;15.5

 ;;30

 ;;31

 ;;32

 ;;32.5

 ;;33

 ;;33.5

 ;;34

 ;;35^M

 ;;42

 ;;43

 ;;44

 ;;45

 ;;46

 ;;48

 ;;49

 ;;52

 ;;53^M

 ;;71

 ;;73

 ;;74^M

 ;;74.5^M

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNV1   3886     printed  Mar 13, 2025@21:26:13                                                                                                                                                                                                    Page 2

QAOSCNV1  ;HISC/DAD-DELETE OLD OCCURRENCE SCREEN FILES/FIELDS ;8/10/93  10:12

 +1       ;;3.0;Occurrence Screen;;09/14/1993

 +2        SET QAOSDD(0)=0

           FOR QAOSDD=513.73:.01:513.79

               SET X=$PIECE($GET(^DIC(QAOSDD,0)),"^")

               SET QAOSDD(QAOSDD)=(X]"")_"^"_QAOSDD_"^"_$SELECT(X]"":X,1:"")

               if X]""

                   SET QAOSDD(0)=1

 +3        SET QAOSFLD(0)=0

           FOR QAOFFSET=1:1

               SET QAOSFLD=$PIECE($TEXT(FLDS+QAOFFSET),";",3)

               if QAOSFLD=""

                   QUIT

               SET X=$GET(^DD(513.72,+QAOSFLD,0))

               SET QAOSFLD(+QAOSFLD)=(X]"")_"^"_$PIECE(X,"^")_"^"_$PIECE(QAOSFLD,"^",2)

               if X]""

                   SET QAOSFLD(0)=1

 +4        if (QAOSDD(0)'>0)&(QAOSFLD(0)'>0)

               GOTO 740

 +5        WRITE !!,"Delete version 1.01 Occurrence Screen files/fields"

 +6        WRITE !,"--------------------------------------------------",!

 +7        if QAOSDD(0)

               DO SHOWFILE

           if QAOSFLD(0)

               DO SHOWFLDS

ASKDEL    ;

 +1        WRITE !!,"Are you sure you want to continue"

           SET %=2

           DO YN^DICN

 +2        IF (%=-1)!(%=2)

               Begin DoDot:1

 +3                WRITE *7,!!!?24,"*** EXITING THE INIT PROCESS ***"

 +4                WRITE !!?12,"Occurrence Screen V3.0 may not be installed until after"

 +5                WRITE !?14,"the successful completion of the pre-init routine !!",*7

 +6                KILL DIFQ

 +7                QUIT

               End DoDot:1

               GOTO EXIT

 +8        IF '%

               Begin DoDot:1

 +9                WRITE !!?5,"Answer Y(es) to delete the items displayed,"

 +10               WRITE !?5,"and continue with the installation."

 +11               WRITE !!?5,"Answering N(o) will leave the files untouched"

 +12               WRITE !?5,"and abort the installation."

 +13               if QAOSDD(0)

                       DO SHOWFILE

                   if QAOSFLD(0)

                       DO SHOWFLDS

 +14               QUIT

               End DoDot:1

               GOTO ASKDEL

 +15       if QAOSDD(0)

               DO DELFILE

           if QAOSFLD(0)

               DO DELFLDS

740       ;

 +1        IF $DATA(^DD(740,741.97,0))[0

               IF $DATA(^DD(740,741.98,0))[0

                   GOTO 741

 +2        WRITE !!,"Delete OS/2.5 temporary conversion fields from file #740"

 +3        WRITE !,"--------------------------------------------------------",!

 +4        WRITE !?5,"Field: 741.97 - ",$PIECE($GET(^DD(740,741.97,0)),"^")

 +5        SET DIK="^DD(740,"

           SET DA=741.97

           SET DA(1)=740

           DO ^DIK

 +6        WRITE !?5,"Field: 741.98 - ",$PIECE($GET(^DD(740,741.98,0)),"^")

 +7        SET DIK="^DD(740,"

           SET DA=741.98

           SET DA(1)=740

           DO ^DIK

           KILL ^QA(740,1,"QAO")

741       ;

 +1        IF $DATA(^QA(741,"AF"))[0

               GOTO 107

 +2        WRITE !!,"Kill the 'AC', 'AF' and 'AE' cross references in file #741"

 +3        WRITE !,"----------------------------------------------------------",!

 +4        KILL DA,DIK

           SET DIK="^DD(741.01,9,1,"

           SET DA(2)=741.01

           SET DA(1)=9

           SET DA=1

 +5        WRITE !?5,"Xref: 'AC'"

           DO ^DIK

           WRITE " killed"

 +6        KILL DA,DIK

           SET DIK="^DD(741,2,1,"

           SET DA(2)=741

           SET DA(1)=2

           SET DA=1

 +7        WRITE !?5,"Xref: 'AF'"

           DO ^DIK

           KILL ^QA(741,"AF")

           WRITE " killed"

 +8        KILL DA,DIK

           SET DIK="^DD(741,14,1,"

           SET DA(2)=741

           SET DA(1)=14

           SET DA=3

 +9        WRITE !?5,"Xref: 'AE'"

           DO ^DIK

           WRITE " killed"

107       ;

 +1        IF $DATA(^QA(741.1,107,0))[0

               GOTO EXIT

 +2        WRITE !!,"Convert screen 107 to return to O.R. within 7 days"

 +3        WRITE !,"--------------------------------------------------",!

 +4        SET QA="UNPLANNED RETURN TO OR IN SAME ADMISSION, OR WITHIN 7 DAYS OF OPERATION"

 +5        WRITE !?5,QA

 +6        KILL DA,DIE,DR

           SET DIE="^QA(741.1,"

           SET DA=107

           SET DR="2///"_QA

 +7        DO ^DIE

EXIT      ;

 +1        KILL %,DA,DIC,DIK,DIU,QAOFFSET,QAOSDD,QAOSFLD,X,Y

 +2        QUIT

SHOWFILE  ;

 +1        WRITE !!,"The following files are about to be deleted:",!

 +2        FOR QAOSDD=513.73:.01:513.79

               if QAOSDD(QAOSDD)

                   WRITE !?5,QAOSDD,?14,$PIECE(QAOSDD(QAOSDD),"^",3)

 +3        QUIT

DELFILE   ;

 +1        WRITE !!,"Deleting files:",!

 +2        FOR QAOSDD=513.73:.01:513.79

               Begin DoDot:1

 +3                if QAOSDD(QAOSDD)'>0

                       QUIT

 +4                WRITE !?5,QAOSDD,?14,$PIECE(QAOSDD(QAOSDD),"^",3)

 +5                SET DIU=QAOSDD

                   SET DIU(0)="DT"

                   DO EN^DIU2

 +6                QUIT

               End DoDot:1

 +7        QUIT

SHOWFLDS  ;

 +1        WRITE !!,"The following fields in the PATIENT QA EVENT file (#513.72)",!,"are about to be deleted:",!

 +2        FOR QAOSFLD=0:0

               SET QAOSFLD=$ORDER(QAOSFLD(QAOSFLD))

               if QAOSFLD'>0

                   QUIT

               Begin DoDot:1

 +3                SET X=QAOSFLD(QAOSFLD)

 +4                IF X

                       WRITE !?5,QAOSFLD,?14,$PIECE(X,"^",2),$SELECT($PIECE(X,"^",3)="M":"   (Mult)",1:"")

 +5                QUIT

               End DoDot:1

 +6        QUIT

DELFLDS   ;

 +1        WRITE !!,"Deleting fields in the PATIENT QA EVENT file (#513.72):",!

 +2        FOR QAOSFLD=0:0

               SET QAOSFLD=$ORDER(QAOSFLD(QAOSFLD))

               if QAOSFLD'>0

                   QUIT

               Begin DoDot:1

 +3                SET X=QAOSFLD(QAOSFLD)

                   if X'>0

                       QUIT

 +4                WRITE !?5,QAOSFLD,?14,$PIECE(X,"^",2),$SELECT($PIECE(X,"^",3)="M":"   (Mult)",1:"")

 +5                IF $PIECE(X,"^",3)="M"

                       Begin DoDot:2

 +6                        SET DIU=+$PIECE(^DD(513.72,QAOSFLD,0),"^",2)

                           SET DIU(0)="DS"

                           DO EN^DIU2

 +7                        QUIT

                       End DoDot:2

 +8               IF '$TEST

                       Begin DoDot:2

 +9                        SET DIK="^DD(513.72,"

                           SET DA=QAOSFLD

                           SET DA(1)=513.72

                           DO ^DIK

 +10                       QUIT

                       End DoDot:2

 +11               QUIT

               End DoDot:1

 +12       QUIT

FLDS      ;;FIELDS IN 513.72 TO BE DELETED ^ 'M' IF FIELD IS MULTIPLE

 +1       ;;9

 +2       ;;10

 +3       ;;12

 +4       ;;13

 +5       ;;14

 +6       ;;15.5

 +7       ;;30

 +8       ;;31

 +9       ;;32

 +10      ;;32.5

 +11      ;;33

 +12      ;;33.5

 +13      ;;34

 +14      ;;35^M

 +15      ;;42

 +16      ;;43

 +17      ;;44

 +18      ;;45

 +19      ;;46

 +20      ;;48

 +21      ;;49

 +22      ;;52

 +23      ;;53^M

 +24      ;;71

 +25      ;;73

 +26      ;;74^M

 +27      ;;74.5^M

QAOSCNV1.m