Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCARAM0

MCARAM0.m

Go to the documentation of this file. 
  1. MCARAM0 ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINITIALIZE ;2/24/95  10:01
  1.  ;;2.3;Medicine;;09/13/1996
  1.  ;
  1.  ;
  1. START ;Driver for MCARECGINIT-ECG Corrupted Records Delete
  1.  ;Deletes corrupted records and reinitializes error summary file
  1.  N MCDT,MCIEN,MCCNT,MCCOR,MCNAME,MCSSN,MCERR,MCEXDT,MCEKG,MCPID,MCNDT
  1.  S (MCDT,MCIEN,MCCNT,MCCOR)=0
  1.  S (MCNAME,MCSSN)=""
  1.  W !,"Warning: This process will delete all of the records listed in"
  1.  W !,"the retransmittal report."
  1.  W !!,"This process will also remove the release status of each"
  1.  W !,"automated record that has a release status."
  1.  W !!,"This process will also add a confirmation status to each"
  1.  W !,"automated record that does not have a confirmation status."
  1.  R !!,"Do you wish to continue ? N //",MCDEF:30 I '$T Q
  1.  I $E(MCDEF)'="Y" Q
  1.  W !!,"Each  "".""  represents 100 records.",!!,"Deleting---"
  1.  ; checks for whole records
  1.  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 "."
  1.  S (MCDT,MCIEN)=0,(MCNAME,MCSSN)=""
  1.  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 "."
  1.  D ^MCARAM0A
  1.  D ^MCARAM0B
  1.  D ^MCARAM0C
  1.  D ^MCARAM0D
  1.  D ^MCARAM0E
  1.  D ^MCARAM0F
  1.  D ^MCARAM0G
  1.  W !!,MCCNT," records deleted."
  1.  W !!,"Each  "".""  represents 100 records.",!!,"Removing release status and adding confirmation status---"
  1.  D ^MCARAM0H
  1.  W !!,"...done."
  1.  Q
  1.  ;
  1. ERR ;
  1.  S MCERR=""
  1.  I $D(^MCAR(700.5,MCIEN,0)),$P(^MCAR(700.5,MCIEN,0),"^",2)="MHOLT" Q
  1.  I '$D(^MCAR(700.5,MCIEN,0)) S MCDT="",MCNAME="",MCSSN="",MCERR="CORRUPTION"
  1.  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)
  1.  I MCDT="" S MCDT="NO DATE/TIME",MCERR="CORRUPTION"
  1.  I MCSSN="" S MCSSN="NO SSN",MCERR="CORRUPTION"
  1.  I MCNAME="" S MCNAME="NO PATIENT NAME ON FILE",MCERR="CORRUPTION"
  1.  I '$D(^MCAR(700.5,"B",MCDT,MCIEN)) S MCERR="CORRUPTION"
  1.  Q
  1.  ;
  1. EKGCK ;
  1.  S MCERR=""
  1.  I '$D(^MCAR(691.5,MCIEN,0)) S MCERR="CORRUPTION",MCPID="",MCDT=""
  1.  I '$D(^MCAR(691.5,MCIEN,.1)) S MCSSN="",MCNAME="",MCERR="CORRUPTION" Q
  1.  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)
  1.  S X=MCSSN,DIC="^DPT(",DIC(0)="XZ",D="SSN" D IX^DIC
  1.  I +Y>0 S MCNAME=$P(Y(0),"^")
  1.  I +Y>0 S MCPIDT=$P(Y,"^")
  1.  I +Y=-1 S MCPIDT="NOPID",MCNAME="NO PATIENT NAME ON FILE"
  1.  I MCPID'=MCPIDT S MCERR="CORRUPTION",MCNDT=$E(MCDT,1,11) D MID
  1.  K X,Y,D,MCPIDT,MCNDT
  1.  I '$D(^MCAR(691.5,"B",MCDT,MCIEN)) S MCERR="CORRUPTION"
  1.  I '$D(^MCAR(691.5,"C",MCPID,MCIEN)) S MCERR="CORRUPTION"
  1.  Q
  1. MID ;
  1.  I '$D(^DPT(MCPID,0)) Q
  1.  I $D(^MCAR(691.5,"B",MCNDT)) S MCNAME=$P(^DPT(MCPID,0),"^"),MCSSN=$P(^DPT(MCPID,0),"^",9) Q
  1.  N MCSSN2,MCNAME2
  1.  S MCSSN2=$P(^DPT(MCPID,0),"^",9) I MCSSN2'[MCPIDT S MCNAME2=$P(^DPT(MCPID,0),"^"),MCCOR=MCCOR+1,MCCNT=MCCNT+1
  1.  K MCSSN2,MCNAME2 Q
  1. DEL ;
  1.  S DIK=MCROOT,DA=MCIEN D ^DIK
  1.  S MCCNT=MCCNT+1 Q
  1.  ;
  1. DELAC ;
  1.  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)
  1.  Q