- 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 Feb 19, 2025@00:00:21 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