RMPR9X ;HOIFO/HNC - X-REF SUSPENSE FILE ;5/6/03 08:08
;;3.0;PROSTHETICS;**59**;Feb 09, 1996
;
Q
EN02 ;Date Closed and number of processing days
N RMPRDAYS S RMPRCD=""
S RMPRCD=$P($P(^RMPR(668,DA,0),U,5),".",1)
N X
S RMPRDAYS=$$PDAY^RMPREOU(DA)
S ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)=""
Q
KILL02 ;
N RMPRDAYS,RMPRCD
S RMPRCD=$P(X,".",1)
S RMPRDAYS=$$PDAY^RMPREOU(DA)
K ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)
Q
EN01 ;L1 x-ref
I X="" Q
N L2,L3,M3
;L2 last 2 ssn
;L3 status
;M3 old status
S DFN=$P($G(^RMPR(668,DA,0)),U,2)
Q:DFN=""
D DEM^VADPT
S L2=$E($P(VADM(2),U,1),8,9)
S L3=$P($G(^RMPR(668,DA,0)),U,10)
Q:L3=""
;last 2 SSN, status, ien
S M3=""
F S M3=$O(^RMPR(668,"L1",L2,M3)) Q:M3="" D
.I $D(^RMPR(668,"L1",L2,M3,DA)) K ^RMPR(668,"L1",L2,M3,DA)
S ^RMPR(668,"L1",L2,L3,DA)=""
K VADM
Q
KILL01 ;kill L1 x-ref
N L2,L3,M3
;L2 last 2 ssn
;L3 status
;M3 old status
S DFN=$P($G(^RMPR(668,DA,0)),U,2)
Q:DFN=""
D DEM^VADPT
S L2=$E($P(VADM(2),U,1),8,9)
S L3=$P($G(^RMPR(668,DA,0)),U,10)
Q:L3=""
;last 2 SSN, status, ien
S M3=""
F S M3=$O(^RMPR(668,"L1",L2,M3)) Q:M3="" D
.I $D(^RMPR(668,"L1",L2,M3,DA)) K ^RMPR(668,"L1",L2,M3,DA)
K VADM
Q
EN0 ;L x-ref
I X="" Q
N L2,L3,L4,M3,M4
S DFN=$P($G(^RMPR(668,DA,0)),U,2)
Q:DFN=""
D DEM^VADPT
S L2=$E($P(VADM(2),U,1),8,9)
S L3=$P($G(^RMPR(668,DA,0)),U,10)
Q:L3=""
S L4=$P($P(^RMPR(668,DA,0),U,1),".",1)
;last 2 SSN, date no time, status, ien
S M4=0
F S M4=$O(^RMPR(668,"L",L2,M4)) Q:M4'>0 D
.S M3=""
.F S M3=$O(^RMPR(668,"L",L2,M4,M3)) Q:M3="" D
. .I $D(^RMPR(668,"L",L2,M4,M3,DA)) K ^RMPR(668,"L",L2,M4,M3,DA)
S ^RMPR(668,"L",L2,L4,L3,DA)=""
K VADM
Q
KILL0 ;
N L2,L3,M3,M4
S DFN=$P($G(^RMPR(668,DA,0)),U,2)
Q:DFN=""
S L3=$P(^RMPR(668,DA,0),U,10)
D DEM^VADPT
S L2=$E($P(VADM(2),U,1),8,9)
;unknown status
S M4=0
F S M4=$O(^RMPR(668,"L",L2,M4)) Q:M4'>0 D
.S M3=""
.F S M3=$O(^RMPR(668,"L",L2,M4,M3)) Q:M3="" D
. .I $D(^RMPR(668,"L",L2,M4,M3,DA)) K ^RMPR(668,"L",L2,M4,M3,DA)
Q
EN ;Create Entry point
I X="C" D KILL Q
I X="X" D KILL Q
I X="" Q
N L2
S DFN=$P($G(^RMPR(668,DA,0)),U,2)
Q:DFN=""
D DEM^VADPT
S L2=$E($P(VADM(2),U,1),8,9)
S ^RMPR(668,"I",L2,DA)=""
K VADM
Q
KILL ;Kill entry point
N L2
S DFN=$P($G(^RMPR(668,DA,0)),U,2)
Q:DFN=""
D DEM^VADPT
S L2=$E($P(VADM(2),U,1),8,9)
K ^RMPR(668,"I",L2,DA)
Q
EN1 ;
S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
S ^RMPR(669.9,"PA",WHOZ,DA(1))=""
Q
KILL1 ;
S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
K ^RMPR(669.9,"PA",WHOZ,DA(1))
Q
EN2 ;PCARD CROSS REFERENCE
S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
S PCRD=$P(^RMPR(669.9,DA(1),5,DA,0),U,5)
S ^RMPR(669.9,"PCRD",WHOZ,PCRD,DA(1))=""
Q
KILL2 ;PCARD CROSS REFERENCE
Q
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9X 2831 printed Apr 09, 2024@21:37:22 Page 2
RMPR9X ;HOIFO/HNC - X-REF SUSPENSE FILE ;5/6/03 08:08
+1 ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
+2 ;
+3 QUIT
EN02 ;Date Closed and number of processing days
+1 NEW RMPRDAYS
SET RMPRCD=""
+2 SET RMPRCD=$PIECE($PIECE(^RMPR(668,DA,0),U,5),".",1)
+3 NEW X
+4 SET RMPRDAYS=$$PDAY^RMPREOU(DA)
+5 SET ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)=""
+6 QUIT
KILL02 ;
+1 NEW RMPRDAYS,RMPRCD
+2 SET RMPRCD=$PIECE(X,".",1)
+3 SET RMPRDAYS=$$PDAY^RMPREOU(DA)
+4 KILL ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)
+5 QUIT
EN01 ;L1 x-ref
+1 IF X=""
QUIT
+2 NEW L2,L3,M3
+3 ;L2 last 2 ssn
+4 ;L3 status
+5 ;M3 old status
+6 SET DFN=$PIECE($GET(^RMPR(668,DA,0)),U,2)
+7 if DFN=""
QUIT
+8 DO DEM^VADPT
+9 SET L2=$EXTRACT($PIECE(VADM(2),U,1),8,9)
+10 SET L3=$PIECE($GET(^RMPR(668,DA,0)),U,10)
+11 if L3=""
QUIT
+12 ;last 2 SSN, status, ien
+13 SET M3=""
+14 FOR
SET M3=$ORDER(^RMPR(668,"L1",L2,M3))
if M3=""
QUIT
Begin DoDot:1
+15 IF $DATA(^RMPR(668,"L1",L2,M3,DA))
KILL ^RMPR(668,"L1",L2,M3,DA)
End DoDot:1
+16 SET ^RMPR(668,"L1",L2,L3,DA)=""
+17 KILL VADM
+18 QUIT
KILL01 ;kill L1 x-ref
+1 NEW L2,L3,M3
+2 ;L2 last 2 ssn
+3 ;L3 status
+4 ;M3 old status
+5 SET DFN=$PIECE($GET(^RMPR(668,DA,0)),U,2)
+6 if DFN=""
QUIT
+7 DO DEM^VADPT
+8 SET L2=$EXTRACT($PIECE(VADM(2),U,1),8,9)
+9 SET L3=$PIECE($GET(^RMPR(668,DA,0)),U,10)
+10 if L3=""
QUIT
+11 ;last 2 SSN, status, ien
+12 SET M3=""
+13 FOR
SET M3=$ORDER(^RMPR(668,"L1",L2,M3))
if M3=""
QUIT
Begin DoDot:1
+14 IF $DATA(^RMPR(668,"L1",L2,M3,DA))
KILL ^RMPR(668,"L1",L2,M3,DA)
End DoDot:1
+15 KILL VADM
+16 QUIT
EN0 ;L x-ref
+1 IF X=""
QUIT
+2 NEW L2,L3,L4,M3,M4
+3 SET DFN=$PIECE($GET(^RMPR(668,DA,0)),U,2)
+4 if DFN=""
QUIT
+5 DO DEM^VADPT
+6 SET L2=$EXTRACT($PIECE(VADM(2),U,1),8,9)
+7 SET L3=$PIECE($GET(^RMPR(668,DA,0)),U,10)
+8 if L3=""
QUIT
+9 SET L4=$PIECE($PIECE(^RMPR(668,DA,0),U,1),".",1)
+10 ;last 2 SSN, date no time, status, ien
+11 SET M4=0
+12 FOR
SET M4=$ORDER(^RMPR(668,"L",L2,M4))
if M4'>0
QUIT
Begin DoDot:1
+13 SET M3=""
+14 FOR
SET M3=$ORDER(^RMPR(668,"L",L2,M4,M3))
if M3=""
QUIT
Begin DoDot:2
+15 IF $DATA(^RMPR(668,"L",L2,M4,M3,DA))
KILL ^RMPR(668,"L",L2,M4,M3,DA)
End DoDot:2
End DoDot:1
+16 SET ^RMPR(668,"L",L2,L4,L3,DA)=""
+17 KILL VADM
+18 QUIT
KILL0 ;
+1 NEW L2,L3,M3,M4
+2 SET DFN=$PIECE($GET(^RMPR(668,DA,0)),U,2)
+3 if DFN=""
QUIT
+4 SET L3=$PIECE(^RMPR(668,DA,0),U,10)
+5 DO DEM^VADPT
+6 SET L2=$EXTRACT($PIECE(VADM(2),U,1),8,9)
+7 ;unknown status
+8 SET M4=0
+9 FOR
SET M4=$ORDER(^RMPR(668,"L",L2,M4))
if M4'>0
QUIT
Begin DoDot:1
+10 SET M3=""
+11 FOR
SET M3=$ORDER(^RMPR(668,"L",L2,M4,M3))
if M3=""
QUIT
Begin DoDot:2
+12 IF $DATA(^RMPR(668,"L",L2,M4,M3,DA))
KILL ^RMPR(668,"L",L2,M4,M3,DA)
End DoDot:2
End DoDot:1
+13 QUIT
EN ;Create Entry point
+1 IF X="C"
DO KILL
QUIT
+2 IF X="X"
DO KILL
QUIT
+3 IF X=""
QUIT
+4 NEW L2
+5 SET DFN=$PIECE($GET(^RMPR(668,DA,0)),U,2)
+6 if DFN=""
QUIT
+7 DO DEM^VADPT
+8 SET L2=$EXTRACT($PIECE(VADM(2),U,1),8,9)
+9 SET ^RMPR(668,"I",L2,DA)=""
+10 KILL VADM
+11 QUIT
KILL ;Kill entry point
+1 NEW L2
+2 SET DFN=$PIECE($GET(^RMPR(668,DA,0)),U,2)
+3 if DFN=""
QUIT
+4 DO DEM^VADPT
+5 SET L2=$EXTRACT($PIECE(VADM(2),U,1),8,9)
+6 KILL ^RMPR(668,"I",L2,DA)
+7 QUIT
EN1 ;
+1 SET WHOZ=$PIECE(^RMPR(669.9,DA(1),5,DA,0),U,1)
+2 SET ^RMPR(669.9,"PA",WHOZ,DA(1))=""
+3 QUIT
KILL1 ;
+1 SET WHOZ=$PIECE(^RMPR(669.9,DA(1),5,DA,0),U,1)
+2 KILL ^RMPR(669.9,"PA",WHOZ,DA(1))
+3 QUIT
EN2 ;PCARD CROSS REFERENCE
+1 SET WHOZ=$PIECE(^RMPR(669.9,DA(1),5,DA,0),U,1)
+2 SET PCRD=$PIECE(^RMPR(669.9,DA(1),5,DA,0),U,5)
+3 SET ^RMPR(669.9,"PCRD",WHOZ,PCRD,DA(1))=""
+4 QUIT
KILL2 ;PCARD CROSS REFERENCE
+1 QUIT
+2 ;END
