PRC5B7A.m

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 ---PRC5B7A   1447     printed  Apr 09, 2024@21:19:26                                                                                                                                                                                                     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       ;