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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCESCON3 646 printed Oct 16, 2024@18:15:40 Page 2
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
