MCARAM0 ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINITIALIZE ;2/24/95 10:01
;;2.3;Medicine;;09/13/1996
;
;
START ;Driver for MCARECGINIT-ECG Corrupted Records Delete
;Deletes corrupted records and reinitializes error summary file
N MCDT,MCIEN,MCCNT,MCCOR,MCNAME,MCSSN,MCERR,MCEXDT,MCEKG,MCPID,MCNDT
S (MCDT,MCIEN,MCCNT,MCCOR)=0
S (MCNAME,MCSSN)=""
W !,"Warning: This process will delete all of the records listed in"
W !,"the retransmittal report."
W !!,"This process will also remove the release status of each"
W !,"automated record that has a release status."
W !!,"This process will also add a confirmation status to each"
W !,"automated record that does not have a confirmation status."
R !!,"Do you wish to continue ? N //",MCDEF:30 I '$T Q
I $E(MCDEF)'="Y" Q
W !!,"Each ""."" represents 100 records.",!!,"Deleting---"
; checks for whole records
F I=1:1 S MCIEN=$O(^MCAR(700.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") S MCROOT="^MCAR(700.5," D ERR I MCERR'="" D DEL S:MCERR="CORRUPTION" MCCOR=MCCOR+1 K MCNAME,MCSSN,MCERR,MCEXDT W:MCCNT#100=0 "."
S (MCDT,MCIEN)=0,(MCNAME,MCSSN)=""
F I=1:1 S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN=""!(MCIEN="B") S MCROOT="^MCAR(691.5," D EKGCK I MCERR'="" D DEL,DELAC S:MCERR="CORRUPTION" MCCOR=MCCOR+1 K MCNAME,MCSSN,MCERR,MCEXDT W:MCCNT#100=0 "."
D ^MCARAM0A
D ^MCARAM0B
D ^MCARAM0C
D ^MCARAM0D
D ^MCARAM0E
D ^MCARAM0F
D ^MCARAM0G
W !!,MCCNT," records deleted."
W !!,"Each ""."" represents 100 records.",!!,"Removing release status and adding confirmation status---"
D ^MCARAM0H
W !!,"...done."
Q
;
ERR ;
S MCERR=""
I $D(^MCAR(700.5,MCIEN,0)),$P(^MCAR(700.5,MCIEN,0),"^",2)="MHOLT" Q
I '$D(^MCAR(700.5,MCIEN,0)) S MCDT="",MCNAME="",MCSSN="",MCERR="CORRUPTION"
S MCDT=$P(^MCAR(700.5,MCIEN,0),"^"),MCSSN=$P(^MCAR(700.5,MCIEN,0),"^",3),MCNAME=$P(^MCAR(700.5,MCIEN,0),"^",4),MCERR=$P(^MCAR(700.5,MCIEN,0),"^",5)
I MCDT="" S MCDT="NO DATE/TIME",MCERR="CORRUPTION"
I MCSSN="" S MCSSN="NO SSN",MCERR="CORRUPTION"
I MCNAME="" S MCNAME="NO PATIENT NAME ON FILE",MCERR="CORRUPTION"
I '$D(^MCAR(700.5,"B",MCDT,MCIEN)) S MCERR="CORRUPTION"
Q
;
EKGCK ;
S MCERR=""
I '$D(^MCAR(691.5,MCIEN,0)) S MCERR="CORRUPTION",MCPID="",MCDT=""
I '$D(^MCAR(691.5,MCIEN,.1)) S MCSSN="",MCNAME="",MCERR="CORRUPTION" Q
I $D(^MCAR(691.5,MCIEN,0)) S MCDT=$P(^MCAR(691.5,MCIEN,0),"^"),MCPID=$P(^MCAR(691.5,MCIEN,0),"^",2),MCSSN=^MCAR(691.5,MCIEN,.1)
S X=MCSSN,DIC="^DPT(",DIC(0)="XZ",D="SSN" D IX^DIC
I +Y>0 S MCNAME=$P(Y(0),"^")
I +Y>0 S MCPIDT=$P(Y,"^")
I +Y=-1 S MCPIDT="NOPID",MCNAME="NO PATIENT NAME ON FILE"
I MCPID'=MCPIDT S MCERR="CORRUPTION",MCNDT=$E(MCDT,1,11) D MID
K X,Y,D,MCPIDT,MCNDT
I '$D(^MCAR(691.5,"B",MCDT,MCIEN)) S MCERR="CORRUPTION"
I '$D(^MCAR(691.5,"C",MCPID,MCIEN)) S MCERR="CORRUPTION"
Q
MID ;
I '$D(^DPT(MCPID,0)) Q
I $D(^MCAR(691.5,"B",MCNDT)) S MCNAME=$P(^DPT(MCPID,0),"^"),MCSSN=$P(^DPT(MCPID,0),"^",9) Q
N MCSSN2,MCNAME2
S MCSSN2=$P(^DPT(MCPID,0),"^",9) I MCSSN2'[MCPIDT S MCNAME2=$P(^DPT(MCPID,0),"^"),MCCOR=MCCOR+1,MCCNT=MCCNT+1
K MCSSN2,MCNAME2 Q
DEL ;
S DIK=MCROOT,DA=MCIEN D ^DIK
S MCCNT=MCCNT+1 Q
;
DELAC ;
I $D(MCDT),$D(MCPID),$D(^MCAR(690,"AC",MCPID,9999999.9999-MCDT,"MCAR(691.5",MCIEN)) K ^MCAR(690,"AC",MCPID,9999999.9999-MCDT,"MCAR(691.5",MCIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0 3327 printed Nov 22, 2024@17:21:55 Page 2
MCARAM0 ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINITIALIZE ;2/24/95 10:01
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
START ;Driver for MCARECGINIT-ECG Corrupted Records Delete
+1 ;Deletes corrupted records and reinitializes error summary file
+2 NEW MCDT,MCIEN,MCCNT,MCCOR,MCNAME,MCSSN,MCERR,MCEXDT,MCEKG,MCPID,MCNDT
+3 SET (MCDT,MCIEN,MCCNT,MCCOR)=0
+4 SET (MCNAME,MCSSN)=""
+5 WRITE !,"Warning: This process will delete all of the records listed in"
+6 WRITE !,"the retransmittal report."
+7 WRITE !!,"This process will also remove the release status of each"
+8 WRITE !,"automated record that has a release status."
+9 WRITE !!,"This process will also add a confirmation status to each"
+10 WRITE !,"automated record that does not have a confirmation status."
+11 READ !!,"Do you wish to continue ? N //",MCDEF:30
IF '$TEST
QUIT
+12 IF $EXTRACT(MCDEF)'="Y"
QUIT
+13 WRITE !!,"Each ""."" represents 100 records.",!!,"Deleting---"
+14 ; checks for whole records
+15 FOR I=1:1
SET MCIEN=$ORDER(^MCAR(700.5,MCIEN))
if MCIEN=""!(MCIEN="B")
QUIT
SET MCROOT="^MCAR(700.5,"
DO ERR
IF MCERR'=""
DO DEL
if MCERR="CORRUPTION"
SET MCCOR=MCCOR+1
KILL MCNAME,MCSSN,MCERR,MCEXDT
if MCCNT#100=0
WRITE "."
+16 SET (MCDT,MCIEN)=0
SET (MCNAME,MCSSN)=""
+17 FOR I=1:1
SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))
if MCIEN=""!(MCIEN="B")
QUIT
SET MCROOT="^MCAR(691.5,"
DO EKGCK
IF MCERR'=""
DO DEL
DO DELAC
if MCERR="CORRUPTION"
SET MCCOR=MCCOR+1
KILL MCNAME,MCSSN,MCERR,MCEXDT
if MCCNT#100=0
WRITE "."
+18 DO ^MCARAM0A
+19 DO ^MCARAM0B
+20 DO ^MCARAM0C
+21 DO ^MCARAM0D
+22 DO ^MCARAM0E
+23 DO ^MCARAM0F
+24 DO ^MCARAM0G
+25 WRITE !!,MCCNT," records deleted."
+26 WRITE !!,"Each ""."" represents 100 records.",!!,"Removing release status and adding confirmation status---"
+27 DO ^MCARAM0H
+28 WRITE !!,"...done."
+29 QUIT
+30 ;
ERR ;
+1 SET MCERR=""
+2 IF $DATA(^MCAR(700.5,MCIEN,0))
IF $PIECE(^MCAR(700.5,MCIEN,0),"^",2)="MHOLT"
QUIT
+3 IF '$DATA(^MCAR(700.5,MCIEN,0))
SET MCDT=""
SET MCNAME=""
SET MCSSN=""
SET MCERR="CORRUPTION"
+4 SET MCDT=$PIECE(^MCAR(700.5,MCIEN,0),"^")
SET MCSSN=$PIECE(^MCAR(700.5,MCIEN,0),"^",3)
SET MCNAME=$PIECE(^MCAR(700.5,MCIEN,0),"^",4)
SET MCERR=$PIECE(^MCAR(700.5,MCIEN,0),"^",5)
+5 IF MCDT=""
SET MCDT="NO DATE/TIME"
SET MCERR="CORRUPTION"
+6 IF MCSSN=""
SET MCSSN="NO SSN"
SET MCERR="CORRUPTION"
+7 IF MCNAME=""
SET MCNAME="NO PATIENT NAME ON FILE"
SET MCERR="CORRUPTION"
+8 IF '$DATA(^MCAR(700.5,"B",MCDT,MCIEN))
SET MCERR="CORRUPTION"
+9 QUIT
+10 ;
EKGCK ;
+1 SET MCERR=""
+2 IF '$DATA(^MCAR(691.5,MCIEN,0))
SET MCERR="CORRUPTION"
SET MCPID=""
SET MCDT=""
+3 IF '$DATA(^MCAR(691.5,MCIEN,.1))
SET MCSSN=""
SET MCNAME=""
SET MCERR="CORRUPTION"
QUIT
+4 IF $DATA(^MCAR(691.5,MCIEN,0))
SET MCDT=$PIECE(^MCAR(691.5,MCIEN,0),"^")
SET MCPID=$PIECE(^MCAR(691.5,MCIEN,0),"^",2)
SET MCSSN=^MCAR(691.5,MCIEN,.1)
+5 SET X=MCSSN
SET DIC="^DPT("
SET DIC(0)="XZ"
SET D="SSN"
DO IX^DIC
+6 IF +Y>0
SET MCNAME=$PIECE(Y(0),"^")
+7 IF +Y>0
SET MCPIDT=$PIECE(Y,"^")
+8 IF +Y=-1
SET MCPIDT="NOPID"
SET MCNAME="NO PATIENT NAME ON FILE"
+9 IF MCPID'=MCPIDT
SET MCERR="CORRUPTION"
SET MCNDT=$EXTRACT(MCDT,1,11)
DO MID
+10 KILL X,Y,D,MCPIDT,MCNDT
+11 IF '$DATA(^MCAR(691.5,"B",MCDT,MCIEN))
SET MCERR="CORRUPTION"
+12 IF '$DATA(^MCAR(691.5,"C",MCPID,MCIEN))
SET MCERR="CORRUPTION"
+13 QUIT
MID ;
+1 IF '$DATA(^DPT(MCPID,0))
QUIT
+2 IF $DATA(^MCAR(691.5,"B",MCNDT))
SET MCNAME=$PIECE(^DPT(MCPID,0),"^")
SET MCSSN=$PIECE(^DPT(MCPID,0),"^",9)
QUIT
+3 NEW MCSSN2,MCNAME2
+4 SET MCSSN2=$PIECE(^DPT(MCPID,0),"^",9)
IF MCSSN2'[MCPIDT
SET MCNAME2=$PIECE(^DPT(MCPID,0),"^")
SET MCCOR=MCCOR+1
SET MCCNT=MCCNT+1
+5 KILL MCSSN2,MCNAME2
QUIT
DEL ;
+1 SET DIK=MCROOT
SET DA=MCIEN
DO ^DIK
+2 SET MCCNT=MCCNT+1
QUIT
+3 ;
DELAC ;
+1 IF $DATA(MCDT)
IF $DATA(MCPID)
IF $DATA(^MCAR(690,"AC",MCPID,9999999.9999-MCDT,"MCAR(691.5",MCIEN))
KILL ^MCAR(690,"AC",MCPID,9999999.9999-MCDT,"MCAR(691.5",MCIEN)
+2 QUIT
