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
Q
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)
Q
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
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
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
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 Dec 13, 2024@02:21:16 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
