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

RMPR9X.m

Go to the documentation of this file.
  1. RMPR9X ;HOIFO/HNC - X-REF SUSPENSE FILE ;5/6/03 08:08
  1. ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
  1. ;
  1. Q
  1. EN02 ;Date Closed and number of processing days
  1. N RMPRDAYS S RMPRCD=""
  1. S RMPRCD=$P($P(^RMPR(668,DA,0),U,5),".",1)
  1. N X
  1. S RMPRDAYS=$$PDAY^RMPREOU(DA)
  1. S ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)=""
  1. Q
  1. KILL02 ;
  1. N RMPRDAYS,RMPRCD
  1. S RMPRCD=$P(X,".",1)
  1. S RMPRDAYS=$$PDAY^RMPREOU(DA)
  1. K ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)
  1. Q
  1. EN01 ;L1 x-ref
  1. I X="" Q
  1. N L2,L3,M3
  1. ;L2 last 2 ssn
  1. ;L3 status
  1. ;M3 old status
  1. S DFN=$P($G(^RMPR(668,DA,0)),U,2)
  1. Q:DFN=""
  1. D DEM^VADPT
  1. S L2=$E($P(VADM(2),U,1),8,9)
  1. S L3=$P($G(^RMPR(668,DA,0)),U,10)
  1. Q:L3=""
  1. ;last 2 SSN, status, ien
  1. S M3=""
  1. F S M3=$O(^RMPR(668,"L1",L2,M3)) Q:M3="" D
  1. .I $D(^RMPR(668,"L1",L2,M3,DA)) K ^RMPR(668,"L1",L2,M3,DA)
  1. S ^RMPR(668,"L1",L2,L3,DA)=""
  1. K VADM
  1. Q
  1. KILL01 ;kill L1 x-ref
  1. N L2,L3,M3
  1. ;L2 last 2 ssn
  1. ;L3 status
  1. ;M3 old status
  1. S DFN=$P($G(^RMPR(668,DA,0)),U,2)
  1. Q:DFN=""
  1. D DEM^VADPT
  1. S L2=$E($P(VADM(2),U,1),8,9)
  1. S L3=$P($G(^RMPR(668,DA,0)),U,10)
  1. Q:L3=""
  1. ;last 2 SSN, status, ien
  1. S M3=""
  1. F S M3=$O(^RMPR(668,"L1",L2,M3)) Q:M3="" D
  1. .I $D(^RMPR(668,"L1",L2,M3,DA)) K ^RMPR(668,"L1",L2,M3,DA)
  1. K VADM
  1. Q
  1. EN0 ;L x-ref
  1. I X="" Q
  1. N L2,L3,L4,M3,M4
  1. S DFN=$P($G(^RMPR(668,DA,0)),U,2)
  1. Q:DFN=""
  1. D DEM^VADPT
  1. S L2=$E($P(VADM(2),U,1),8,9)
  1. S L3=$P($G(^RMPR(668,DA,0)),U,10)
  1. Q:L3=""
  1. S L4=$P($P(^RMPR(668,DA,0),U,1),".",1)
  1. ;last 2 SSN, date no time, status, ien
  1. S M4=0
  1. F S M4=$O(^RMPR(668,"L",L2,M4)) Q:M4'>0 D
  1. .S M3=""
  1. .F S M3=$O(^RMPR(668,"L",L2,M4,M3)) Q:M3="" D
  1. . .I $D(^RMPR(668,"L",L2,M4,M3,DA)) K ^RMPR(668,"L",L2,M4,M3,DA)
  1. S ^RMPR(668,"L",L2,L4,L3,DA)=""
  1. K VADM
  1. Q
  1. KILL0 ;
  1. N L2,L3,M3,M4
  1. S DFN=$P($G(^RMPR(668,DA,0)),U,2)
  1. Q:DFN=""
  1. S L3=$P(^RMPR(668,DA,0),U,10)
  1. D DEM^VADPT
  1. S L2=$E($P(VADM(2),U,1),8,9)
  1. ;unknown status
  1. S M4=0
  1. F S M4=$O(^RMPR(668,"L",L2,M4)) Q:M4'>0 D
  1. .S M3=""
  1. .F S M3=$O(^RMPR(668,"L",L2,M4,M3)) Q:M3="" D
  1. . .I $D(^RMPR(668,"L",L2,M4,M3,DA)) K ^RMPR(668,"L",L2,M4,M3,DA)
  1. Q
  1. EN ;Create Entry point
  1. I X="C" D KILL Q
  1. I X="X" D KILL Q
  1. I X="" Q
  1. N L2
  1. S DFN=$P($G(^RMPR(668,DA,0)),U,2)
  1. Q:DFN=""
  1. D DEM^VADPT
  1. S L2=$E($P(VADM(2),U,1),8,9)
  1. S ^RMPR(668,"I",L2,DA)=""
  1. K VADM
  1. Q
  1. KILL ;Kill entry point
  1. N L2
  1. S DFN=$P($G(^RMPR(668,DA,0)),U,2)
  1. Q:DFN=""
  1. D DEM^VADPT
  1. S L2=$E($P(VADM(2),U,1),8,9)
  1. K ^RMPR(668,"I",L2,DA)
  1. Q
  1. EN1 ;
  1. S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
  1. S ^RMPR(669.9,"PA",WHOZ,DA(1))=""
  1. Q
  1. KILL1 ;
  1. S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
  1. K ^RMPR(669.9,"PA",WHOZ,DA(1))
  1. Q
  1. EN2 ;PCARD CROSS REFERENCE
  1. S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
  1. S PCRD=$P(^RMPR(669.9,DA(1),5,DA,0),U,5)
  1. S ^RMPR(669.9,"PCRD",WHOZ,PCRD,DA(1))=""
  1. Q
  1. KILL2 ;PCARD CROSS REFERENCE
  1. Q
  1. ;END