MCESCON3.m

MCESCON3 ;WISC/DCB-CONVERT RELEASE CODES TO NEW CODES ;3/9/93

 ;;2.3;Medicine;;09/13/1996

START ; This looks like a good place to start

 S MCARGDA=.9,MCFILE=691.5

 F  D LOOP Q:MCARGDA=0

 K MCARGDA,TEMP,CODE,NEWCOE

 Q

LOOP ; loop at the ES node and check to see if its vailite

 S MCARGDA=+$O(^MCAR(MCFILE,MCARGDA)) Q:MCARGDA=0

 S TEMP=$G(^MCAR(MCFILE,MCARGDA,"ES")) Q:TEMP=""

 S CODE=+$P(TEMP,U,7) ; get the code

 D:CODE'=0 CHANGE(CODE,MCARGDA)

 Q

CHANGE(CODE,DA) ;

 N NEWCODE,DIE,DR

 S NEWCODE=$S(CODE=2:"PD",CODE=3:"RV",CODE=4:"ROV",CODE=5:"RNV",CODE=6:"S",1:"D")

 S DIE="^MCAR("_MCFILE_",",DR="1506////^S X=NEWCODE" D ^DIE

 Q

MCESCON3  ;WISC/DCB-CONVERT RELEASE CODES TO NEW CODES ;3/9/93

 +1       ;;2.3;Medicine;;09/13/1996

START     ; This looks like a good place to start

 +1        SET MCARGDA=.9

           SET MCFILE=691.5

 +2        FOR 

               DO LOOP

               IF MCARGDA=0

                   QUIT 

 +3        KILL MCARGDA,TEMP,CODE,NEWCOE

 +4        QUIT 

LOOP      ; loop at the ES node and check to see if its vailite

 +1        SET MCARGDA=+$ORDER(^MCAR(MCFILE,MCARGDA))

           IF MCARGDA=0

               QUIT 

 +2        SET TEMP=$GET(^MCAR(MCFILE,MCARGDA,"ES"))

           IF TEMP=""

               QUIT 

 +3       ; get the code

           SET CODE=+$PIECE(TEMP,U,7)

 +4        IF CODE'=0

               DO CHANGE(CODE,MCARGDA)

 +5        QUIT 

CHANGE(CODE,DA) ;

 +1        NEW NEWCODE,DIE,DR

 +2        SET NEWCODE=$SELECT(CODE=2:"PD",CODE=3:"RV",CODE=4:"ROV",CODE=5:"RNV",CODE=6:"S",1:"D")

 +3        SET DIE="^MCAR("_MCFILE_","

           SET DR="1506////^S X=NEWCODE"

           DO ^DIE

 +4        QUIT