PRC5B7A ;WISC/PLT-PRC5B7 CONTINUE ;7/30/94 03:07
V ;;5.0;IFCAP;;4/21/95
QUIT ;invalid entry
EN ;clean MO/SO ifcap v5 conversion doc first
;
;DELETE CONVERSION MO/SO RRECORD
N PRCRI,PRCA,PRCB,PRCC,PRCD,PRCE,PRCF,A,B,C
G:$O(^GECS(2100.1,"B",""))="" EN1
D EN^DDIOL("DELETE CONVERSION MO/SO RECORD STARTS"_" at "_$$NOW^PRC5A)
S PRCRI(2100.1)=0
F S PRCRI(2100.1)=$O(^GECS(2100.1,PRCRI(2100.1))) Q:'PRCRI(2100.1) D
. S PRCA=$G(^GECS(2100.1,PRCRI(2100.1),1))
. I PRCA'["Conversion Original Entry",PRCA'["Conversion Modification Entry" QUIT
. S PRCB=$P(^GECS(2100.1,PRCRI(2100.1),0)," ",1)
. S PRCC=$E(PRCB,4,6)_"-"_$E(PRCB,7,999),PRCRI(442)=$O(^PRC(442,"B",PRCC,""))
. QUIT:'PRCRI(442)
. W !!,PRCRI(2100.1)," ",PRCA,!,PRCB," ",PRCC," ",PRCRI(442)
. ;CLEAN 422 NODE 10 MO/SO DATA
. S PRCE=$G(^PRC(442,PRCRI(442),10,0)),PRCE=$P(PRCE,"^",3)
. F PRCF=PRCE:-1:1 S A=$G(^PRC(442,PRCRI(442),10,PRCF,0)) D:A?1"MO".E!(A?1"SO".E) QUIT
.. D DELETE^PRC0B1(.X,"442;^PRC(442,;"_PRCRI(442)_"~442.09;^PRC(442,"_PRCRI(442)_",10,;"_PRCF) W " ",PRCF
. D DELETE^PRC0B1(.X,"2100.1;^GECS(2100.1,;"_PRCRI(2100.1))
. QUIT
D EN^DDIOL("DELETE CONVERSION MO/SO RECORD IN FILE 2100.1 DONE! AT "_$$NOW^PRC5A)
EN1 ;dlelte file 411.3 for conversion entry
F S PRCA=$O(^PRC(411.3,"AD",0)) QUIT:'PRCA D:PRCA
. D DELETE^PRC0B1(.X,"411.3;^PRC(411.3,;"_PRCA)
. K ^PRC(411.3,"AD",PRCA)
. QUIT
K ^PRC(411.3,"AD")
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5B7A 1447 printed Nov 22, 2024@17:10:02 Page 2
PRC5B7A ;WISC/PLT-PRC5B7 CONTINUE ;7/30/94 03:07
V ;;5.0;IFCAP;;4/21/95
+1 ;invalid entry
QUIT
EN ;clean MO/SO ifcap v5 conversion doc first
+1 ;
+2 ;DELETE CONVERSION MO/SO RRECORD
+3 NEW PRCRI,PRCA,PRCB,PRCC,PRCD,PRCE,PRCF,A,B,C
+4 if $ORDER(^GECS(2100.1,"B",""))=""
GOTO EN1
+5 DO EN^DDIOL("DELETE CONVERSION MO/SO RECORD STARTS"_" at "_$$NOW^PRC5A)
+6 SET PRCRI(2100.1)=0
+7 FOR
SET PRCRI(2100.1)=$ORDER(^GECS(2100.1,PRCRI(2100.1)))
if 'PRCRI(2100.1)
QUIT
Begin DoDot:1
+8 SET PRCA=$GET(^GECS(2100.1,PRCRI(2100.1),1))
+9 IF PRCA'["Conversion Original Entry"
IF PRCA'["Conversion Modification Entry"
QUIT
+10 SET PRCB=$PIECE(^GECS(2100.1,PRCRI(2100.1),0)," ",1)
+11 SET PRCC=$EXTRACT(PRCB,4,6)_"-"_$EXTRACT(PRCB,7,999)
SET PRCRI(442)=$ORDER(^PRC(442,"B",PRCC,""))
+12 if 'PRCRI(442)
QUIT
+13 WRITE !!,PRCRI(2100.1)," ",PRCA,!,PRCB," ",PRCC," ",PRCRI(442)
+14 ;CLEAN 422 NODE 10 MO/SO DATA
+15 SET PRCE=$GET(^PRC(442,PRCRI(442),10,0))
SET PRCE=$PIECE(PRCE,"^",3)
+16 FOR PRCF=PRCE:-1:1
SET A=$GET(^PRC(442,PRCRI(442),10,PRCF,0))
if A?1"MO".E!(A?1"SO".E)
Begin DoDot:2
+17 DO DELETE^PRC0B1(.X,"442;^PRC(442,;"_PRCRI(442)_"~442.09;^PRC(442,"_PRCRI(442)_",10,;"_PRCF)
WRITE " ",PRCF
End DoDot:2
QUIT
+18 DO DELETE^PRC0B1(.X,"2100.1;^GECS(2100.1,;"_PRCRI(2100.1))
+19 QUIT
End DoDot:1
+20 DO EN^DDIOL("DELETE CONVERSION MO/SO RECORD IN FILE 2100.1 DONE! AT "_$$NOW^PRC5A)
EN1 ;dlelte file 411.3 for conversion entry
+1 FOR
SET PRCA=$ORDER(^PRC(411.3,"AD",0))
if 'PRCA
QUIT
if PRCA
Begin DoDot:1
+2 DO DELETE^PRC0B1(.X,"411.3;^PRC(411.3,;"_PRCA)
+3 KILL ^PRC(411.3,"AD",PRCA)
+4 QUIT
End DoDot:1
+5 KILL ^PRC(411.3,"AD")
+6 QUIT
+7 ;
