QANCNV00 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;10/7/92
;;2.0;Incident Reporting;**1,2**;08/07/1992
;
EN0 ;Check file 513.73 for the existance of data.
; *** Variable list ***
; EXIST ---> Boolean, does incident data exist in global 513.72?
; QAFLG ---> Boolean, do we wish to purge converted records?
; QAFOUND ---> Boolean, do converted records exist?
;
S QAFOUND=0
I '$D(^PRMQ(513.72,"E")),('$D(^PRMQ(513.72,"INC"))) S EXIST=0
E S EXIST=1
D:'EXIST DELETE ;Check for converted records, if found, ask to delete.
I 'EXIST,(QAFOUND),($D(QAFLG)),(QAFLG) D PURGE ;If data does not exist,
;and converted records are found, and we wish to purge, do the purge.
I 'EXIST W !?5,$S(+$G(QAFLG):"Converted records were deleted.",1:"No data to be converted, no action taken.") D EXIT Q ;With no data to convert, kill variables and quit.
;
;We know we have data, "E" and "INC" are xrefs on the same field.
;Both exist or neither exist.
;
D EXIT S QAFOUND=0,EXIST=1 D DELETE ;Check if old converted records xist.
Q:$D(DIRUT)!($D(DIROUT))
I 'QAFOUND D CONVERT,EXIT Q
I QAFOUND,($D(QAFLG)),(QAFLG) D PURGE,^QANCNV0
I QAFOUND,($D(QAFLG)),('QAFLG) D DELUTL
EXIT ;Kill and quit.
K DA,DIK,DIR,EXIST,QA,QACONV,QAFLG,QAFOUND,QB,QC,X,Y
Q
CONVERT ;Ask for a first time conversion.
K DIR S DIR(0)="Y",DIR("B")="No",DIR("?")="Enter 'N' for no, 'Y' for yes."
S DIR("A")="Do you wish to convert old Incident Reporting data"
D ^DIR K DIR S QACONV=+Y Q:$D(DIRUT)!($D(DIROUT))
W ! D:'QACONV DELUTL D:QACONV ^QANCNV0
Q
DELETE ;Check if any converted records exist.
S QA=""
F S QA=$O(^QA(742.4,"B",QA)) Q:QA=""!(QAFOUND) D
. S QA("FIRST")=$P(QA,".") Q:QA("FIRST")']""
. I $E(QA("FIRST"),$L(QA("FIRST")))?1A S QAFOUND=1 D
.. K DIR S DIR(0)="Y"
.. S DIR("A")="Do you wish to delete converted data"_$S(EXIST:" and reconvert",1:"")
.. S DIR("B")="No",DIR("?")="Enter 'N' for no, 'Y' for yes." D ^DIR
.. K DIR S QAFLG=+Y W !
.. Q
. Q
Q
DELUTL ;Delete utility for IR data in '^PRMQ(513.72'.
K DIR
S DIR(0)="Y",DIR("B")="No",DIR("?")="Enter 'N' for no, 'Y' for yes."
S DIR("A",1)="Are you sure about your decision to delete Incident Reporting"
S DIR("A")="data from the '^PRMQ(513.72' global" D ^DIR K DIR W !
Q:+Y'>0
F QA=0:0 S QA=$O(^PRMQ(513.72,"E",QA)) Q:QA'>0 D
. F QB=0:0 S QA=$O(^PRMQ(513.72,"E",QA,QB)) Q:QB'>0 D
.. W !?5,"Deleting data global: ^PRMQ(513.72,"_QB_",0)"
.. K DA,DIK S DA=QB,DIK="^PRMQ(513.72," D ^DIK K DA,DIK
.. Q
. Q
Q
PURGE ;Delete converted records form files: 742 and 742.4.
K QA,QB,QC S QA=""
F S QA=$O(^QA(742.4,"B",QA)) Q:QA="" D
. S QA("FIRST")=$P(QA,".") Q:QA("FIRST")']""
. Q:$E(QA("FIRST"),$L(QA("FIRST")))'?1A ;Quit if not converted.
. F QB=0:0 S QB=$O(^QA(742.4,"B",QA,QB)) Q:QB'>0 D
.. N QA F QC=0:0 S QC=$O(^QA(742,"BCS",QB,QC)) Q:QC'>0 D
... W !!,"Killing data global ^QA(742,"_QC_",0)"
... K DA,DIK S DA=QC,DIK="^QA(742," D ^DIK K DA,DIK
... W !,"Killing data global ^QA(742.4,"_QB_",0)"
... K DA,DIK S DA=QB,DIK="^QA(742.4," D ^DIK K DA,DIK
... K:$D(^QA(742.4,"ACN",QC,QB)) ^QA(742.4,"ACN",QC,QB)
... I $D(^QA(740.5,"AA",742,QC))\10 S DA=+$O(^QA(740.5,"AA",742,QC,0))
... I S DIK="^QA(740.5," W:DA>0 !,"Deleting the QA Audit file entry: ^QA(740.5,"_DA_",0)" D:DA>0 ^DIK K DA,DIK
... I $D(^QA(740.5,"AA",742.4,QB))\10 S DA=+$O(^QA(740.5,"AA",742.4,QB,0))
... I S DIK="^QA(740.5," W:DA>0 !,"Deleting the QA Audit file entry: ^QA(740.5,"_DA_",0)" D:DA>0 ^DIK K DA,DIK
... Q
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANCNV00 3562 printed Oct 16, 2024@18:00:23 Page 2
QANCNV00 ;HISC/GJC-Conversion of data from V1.01 to V2.0 ;10/7/92
+1 ;;2.0;Incident Reporting;**1,2**;08/07/1992
+2 ;
EN0 ;Check file 513.73 for the existance of data.
+1 ; *** Variable list ***
+2 ; EXIST ---> Boolean, does incident data exist in global 513.72?
+3 ; QAFLG ---> Boolean, do we wish to purge converted records?
+4 ; QAFOUND ---> Boolean, do converted records exist?
+5 ;
+6 SET QAFOUND=0
+7 IF '$DATA(^PRMQ(513.72,"E"))
IF ('$DATA(^PRMQ(513.72,"INC")))
SET EXIST=0
+8 IF '$TEST
SET EXIST=1
+9 ;Check for converted records, if found, ask to delete.
if 'EXIST
DO DELETE
+10 ;If data does not exist,
IF 'EXIST
IF (QAFOUND)
IF ($DATA(QAFLG))
IF (QAFLG)
DO PURGE
+11 ;and converted records are found, and we wish to purge, do the purge.
+12 ;With no data to convert, kill variables and quit.
IF 'EXIST
WRITE !?5,$SELECT(+$GET(QAFLG):"Converted records were deleted.",1:"No data to be converted, no action taken.")
DO EXIT
QUIT
+13 ;
+14 ;We know we have data, "E" and "INC" are xrefs on the same field.
+15 ;Both exist or neither exist.
+16 ;
+17 ;Check if old converted records xist.
DO EXIT
SET QAFOUND=0
SET EXIST=1
DO DELETE
+18 if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
+19 IF 'QAFOUND
DO CONVERT
DO EXIT
QUIT
+20 IF QAFOUND
IF ($DATA(QAFLG))
IF (QAFLG)
DO PURGE
DO ^QANCNV0
+21 IF QAFOUND
IF ($DATA(QAFLG))
IF ('QAFLG)
DO DELUTL
EXIT ;Kill and quit.
+1 KILL DA,DIK,DIR,EXIST,QA,QACONV,QAFLG,QAFOUND,QB,QC,X,Y
+2 QUIT
CONVERT ;Ask for a first time conversion.
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="No"
SET DIR("?")="Enter 'N' for no, 'Y' for yes."
+2 SET DIR("A")="Do you wish to convert old Incident Reporting data"
+3 DO ^DIR
KILL DIR
SET QACONV=+Y
if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
+4 WRITE !
if 'QACONV
DO DELUTL
if QACONV
DO ^QANCNV0
+5 QUIT
DELETE ;Check if any converted records exist.
+1 SET QA=""
+2 FOR
SET QA=$ORDER(^QA(742.4,"B",QA))
if QA=""!(QAFOUND)
QUIT
Begin DoDot:1
+3 SET QA("FIRST")=$PIECE(QA,".")
if QA("FIRST")']""
QUIT
+4 IF $EXTRACT(QA("FIRST"),$LENGTH(QA("FIRST")))?1A
SET QAFOUND=1
Begin DoDot:2
+5 KILL DIR
SET DIR(0)="Y"
+6 SET DIR("A")="Do you wish to delete converted data"_$SELECT(EXIST:" and reconvert",1:"")
+7 SET DIR("B")="No"
SET DIR("?")="Enter 'N' for no, 'Y' for yes."
DO ^DIR
+8 KILL DIR
SET QAFLG=+Y
WRITE !
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
DELUTL ;Delete utility for IR data in '^PRMQ(513.72'.
+1 KILL DIR
+2 SET DIR(0)="Y"
SET DIR("B")="No"
SET DIR("?")="Enter 'N' for no, 'Y' for yes."
+3 SET DIR("A",1)="Are you sure about your decision to delete Incident Reporting"
+4 SET DIR("A")="data from the '^PRMQ(513.72' global"
DO ^DIR
KILL DIR
WRITE !
+5 if +Y'>0
QUIT
+6 FOR QA=0:0
SET QA=$ORDER(^PRMQ(513.72,"E",QA))
if QA'>0
QUIT
Begin DoDot:1
+7 FOR QB=0:0
SET QA=$ORDER(^PRMQ(513.72,"E",QA,QB))
if QB'>0
QUIT
Begin DoDot:2
+8 WRITE !?5,"Deleting data global: ^PRMQ(513.72,"_QB_",0)"
+9 KILL DA,DIK
SET DA=QB
SET DIK="^PRMQ(513.72,"
DO ^DIK
KILL DA,DIK
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
PURGE ;Delete converted records form files: 742 and 742.4.
+1 KILL QA,QB,QC
SET QA=""
+2 FOR
SET QA=$ORDER(^QA(742.4,"B",QA))
if QA=""
QUIT
Begin DoDot:1
+3 SET QA("FIRST")=$PIECE(QA,".")
if QA("FIRST")']""
QUIT
+4 ;Quit if not converted.
if $EXTRACT(QA("FIRST"),$LENGTH(QA("FIRST")))'?1A
QUIT
+5 FOR QB=0:0
SET QB=$ORDER(^QA(742.4,"B",QA,QB))
if QB'>0
QUIT
Begin DoDot:2
+6 NEW QA
FOR QC=0:0
SET QC=$ORDER(^QA(742,"BCS",QB,QC))
if QC'>0
QUIT
Begin DoDot:3
+7 WRITE !!,"Killing data global ^QA(742,"_QC_",0)"
+8 KILL DA,DIK
SET DA=QC
SET DIK="^QA(742,"
DO ^DIK
KILL DA,DIK
+9 WRITE !,"Killing data global ^QA(742.4,"_QB_",0)"
+10 KILL DA,DIK
SET DA=QB
SET DIK="^QA(742.4,"
DO ^DIK
KILL DA,DIK
+11 if $DATA(^QA(742.4,"ACN",QC,QB))
KILL ^QA(742.4,"ACN",QC,QB)
+12 IF $DATA(^QA(740.5,"AA",742,QC))\10
SET DA=+$ORDER(^QA(740.5,"AA",742,QC,0))
+13 IF $TEST
SET DIK="^QA(740.5,"
if DA>0
WRITE !,"Deleting the QA Audit file entry: ^QA(740.5,"_DA_",0)"
if DA>0
DO ^DIK
KILL DA,DIK
+14 IF $DATA(^QA(740.5,"AA",742.4,QB))\10
SET DA=+$ORDER(^QA(740.5,"AA",742.4,QB,0))
+15 IF $TEST
SET DIK="^QA(740.5,"
if DA>0
WRITE !,"Deleting the QA Audit file entry: ^QA(740.5,"_DA_",0)"
if DA>0
DO ^DIK
KILL DA,DIK
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
