ICD187PT ; ALB/ADL - GROUPER DRIVER ; 04/11/03
;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 7
;;**routine to build the new DRG global levels required for the CSV project
;;**taken from routine created by DEK to add new "66" levels to ICD0 and ICD9
;;**it addes the "DRG" levels to the 66 multiples in ICD0 (#80.1) and ICD9 (#80) and
;;**it creates the 66 multiple levels in the DRG file (ICD/#80.2)
N I,FILE,CSD,NODE,FLAG,FLGN,CSIN,CSIP,CSAN,CSAP,ADATE,IDATE
S U="^"
F I=2:1 S CSD=$P($T(ADJDATA+I),";;",2) Q:CSD']"" D
. S FILE=$P(CSD,U),NODE=$P(CSD,U,2),FLAG=$P(CSD,U,3),FLGN=$P(CSD,U,10)
. S CSIN=$P(CSD,U,4),CSIP=$P(CSD,U,5),CSAN=$P(CSD,U,6)
. S CSAP=$P(CSD,U,7),ADATE=$P(CSD,U,8),IDATE=$P(CSD,U,9),MDC=$P(CSD,U,11),SURG=$P(CSD,U,12)
. D MAINLOOP(^DIC(FILE,0,"GL"),0)
Q
;
MAINLOOP(ROOT,IEN) ;
N DKZ,RC,STAT,IDT,ADT,S,DRGZ S S="////"
W !!!?5,"APPLYING EDITS TO FILE ",FILE,!
I FILE=80.2 D CLEANUP ;Remove old "66" levels before inserting new ones into ICD file
F S IEN=$O(@(ROOT_IEN_")")) Q:'+IEN D
. S DKZ=$G(@(ROOT_IEN_",0)")),STAT=+$P(DKZ,U,FLAG) ; zero node, status
. S IDT=$P(DKZ,U,CSIP),ADT=$P(DKZ,U,CSAP) ; in/active dates
. I FILE<81 D Q
. . I FILE=80.2 S MDCD=$P(DKZ,U,MDC),SURGD=$P(DKZ,U,SURG) D ALTERDRG Q
. . I FILE=80 S DRGZ=$G(@(ROOT_IEN_",""DRG"")"))
. . I FILE=80.1 S DRGZ="^^^^^",SS=$O(@(ROOT_IEN_",""MDC"",99999)"),-1) I SS'="" S DRGZ=$G(@(ROOT_IEN_",""MDC"","_SS_",""DRG"")"))
. . D ALTERICD
. D ALTERCPT
Q
ALTERICD ;
N ANS,AD,ID,DR
I 'STAT S AD=$S(IDT="":ADATE,1:IDT),DR=CSAN_S_AD
E S ID=$S(IDT="":IDATE,1:IDT),DR=CSIN_S_ID_";"_CSAN_S_ADATE
;S ANS=$$EDIT0(IEN,ROOT,DR) ;*DON'T RUN TO REBUILD .01 LEVEL
S ANS=1
;W !,"IEN ",IEN,$S('ANS:" IN USE",1:" EDITED")
;
I 'STAT D ADDMULT(FILE,IEN,NODE,AD,1,DRGZ)
I STAT D ADDMULT(FILE,IEN,NODE,ID,0,DRGZ)
Q
;
ALTERDRG ;
N ANS,AD,ID,DR,EFFDT,EFFDT2,ACTFLG,FIRSTSET
;I $D(@(ROOT_IEN_",66)")) Q
S FY=0,ACTFLG=0,FIRSTSET=0 ;Default ACTLFG=0 to start
F S FY=$O(@(ROOT_IEN_",""FY"",FY)")) Q:FY="" S FYINFO=^(FY,0),WGHT=$P(FYINFO,U,2),UPDT=$S((+WGHT)&('ACTFLG):1,(+WGHT=0)&(ACTFLG):1,1:0) I UPDT!('FIRSTSET) D
. S EFFDT=($E(FY,1,3)-1)_"1001" I EFFDT<2821001 Q ;Ignore dates before FY 1983
. I 'FIRSTSET&(+WGHT=0) D ;1st FY date WEIGHT = 0 (INACTIVE) - must have 1st entry = ACTIVE so create one
. . S EFFDT2=2821001 D ADDDRGZ(FILE,IEN,NODE,EFFDT2,1,MDCD,SURGD) ;add FY 1983 w/status of ACTIVE
. . S ACTFLG=1
. S FIRSTSET=1
. I EFFDT=2821001&(ACTFLG) Q ;First FY date = 2830000. Don't add second EFF DT entry for FY 2830000
. I ACTFLG D ADDDRGZ(FILE,IEN,NODE,EFFDT,0,MDCD,SURGD) S ACTFLG=0 Q ;add INACTIVE node
. I 'ACTFLG D ADDDRGZ(FILE,IEN,NODE,EFFDT,1,MDCD,SURGD) S ACTFLG=1 ;add ACTIVE node
Q
;
CLEANUP ;REMOVE 66 LEVELS TO REPROCESS
S CD=0
F S CD=$O(^ICD(CD)) Q:CD="" K ^ICD(CD,66)
Q ;CLEANUP
ALTERCPT ;
N DR,AD,ID,ANS,EFF,EFFS
S EFF=$$EFF(FILE,IEN)
S EFFS=$P(EFF,U,2),ID=$P(EFF,U,3),AD=$P(EFF,U,4),DR=CSAN_S_AD
S:'EFFS DR=DR_";"_CSIN_S_ID
I EFFS'=1-STAT S DR=DR_";"_FLGN_S_EFFS
S ANS=$$EDIT0(IEN,ROOT,DR)
;W !,"IEN ",IEN,$S('ANS:" IN USE",1:" EDITED")
;
I AD=ADATE D ADDMULT(FILE,IEN,NODE,AD,1)
I 'EFFS,ID=IDATE D ADDMULT(FILE,IEN,NODE,ID,0)
Q
;
EFF(FILE,CODE) ;
N EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFBOOL,EFFDOS,EFFDFLT
S EFFDFLT="2890101^1^2900101^2890101",EFILE=^DIC(FILE,0,"GL")_CODE_",60,"
S EFF=$O(@(EFILE_"""B"","_(DT+.001)_")"),-1) I 'EFF Q EFFDFLT
S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) ; node 60 (effective date) sub-entry
S STR=$G(@(EFILE_EFFN_",0)")) I 'STR Q EFFDFLT
;set Opposite eff. date based on status
S EFFDT=+STR,EFFST=$P(STR,U,2),EFFBOOL=0
F S EFF=$O(@(EFILE_"""B"","_EFF_")"),-1) Q:'EFF!EFFBOOL D
. S EFFN=$O(@(EFILE_"""B"","_EFF_",0)"))
. S EFFDOS=$G(@(EFILE_EFFN_",0)")) I 'EFFDOS S EFF="" Q
. S EFFBOOL=(EFFST'=$P(EFFDOS,U,2))
S EFFDOS=$G(EFFDOS,$S('EFFST:$P(EFFDFLT,U),1:$P(EFFDFLT,U,3)))
I EFFST S $P(STR,U,3,4)=(+EFFDOS)_U_EFFDT
E S $P(STR,U,3,4)=EFFDT_U_(+EFFDOS)
Q STR
;
EDIT0(DA,DIE,DR) ; adjust zero node
N REC S REC=DA
L +@(DIE_REC_",0)"):2 I D Q 1
. D ^DIE
. L -@(DIE_REC_",0)")
Q 0
;
ADDMULT(FN,IEN,NODE,X,STA,DRGZ) ; add to multiple
N FDA,FDAIEN,ANS
S FN=+$P(^DD(FN,NODE,0),U,2)
S FDAIEN="1,"_IEN_","
K ^TMP("DIERR",$J)
;S FDA(FN,FDAIEN,.01)=X ;NOT REQ'D SINCE ICD*18.0*6 ALREADY BUILT THIS LEVEL
;S FDA(FN,FDAIEN,.02)=STA ;NOT REQ'D SINCE ICD*18.0*6 ALREADY BUILT THIS LEVEL
F DRGCNT=1:1:6 S FDA(FN,FDAIEN,59+DRGCNT)=$P(DRGZ,"^",DRGCNT)
D UPDATE^DIE("","FDA")
S ANS='$D(^TMP("DIERR",$J))
;W !,"IEN ",IEN,$S('ANS:" DIDNT",1:" DID")," ADD ",STA
Q
;
ADDDRGZ(FN,IEN,NODE,X,STA,MDCD,SURGD) ; add to DRG multiple
N FDA,FDAIEN,ANS
S FN=+$P(^DD(FN,NODE,0),U,2)
S FDAIEN="+1,"_IEN_","
K ^TMP("DIERR",$J)
S FDA(FN,FDAIEN,.01)=X
S FDA(FN,FDAIEN,.03)=STA
S FDA(FN,FDAIEN,.05)=MDCD
S FDA(FN,FDAIEN,.06)=SURGD
;F DRGCNT=1:1:6 S FDA(FN,FDAIEN,59+DRGCBT)=$P(DRGZ,"^",DRGCNT)
D UPDATE^DIE("","FDA")
S ANS='$D(^TMP("DIERR",$J))
;W !,"IEN ",IEN,$S('ANS:" DIDNT",1:" DID")," ADD ",STA
Q
;
SETINACT(IEN) ;set inactive dates for DRG codes
N FY
S FY=0
F S FY=$O(^ICD(IEN,"FY",FY)) Q:FY="" I +$P(^ICD(IEN,"FY",FY,0),"^",2)=0 D Q
. S DATE=$E(FY,1,3)_"1001"
. I $D(^ICD(IEN,66,"B",DATE)) Q
. D ADDDRGZ(FILE,IEN,NODE,DATE,0,MDCD,SURGD) ; add w/date of 10/1 of FY and STATUS of 0 (INACTIVE)
. W !,"UPDATING ",IEN," TO INACTIVE"
Q ;SETINACT
;
UPDATE ; SET INACTIVE DRG LEVELS
N I,FILE,CSD,NODE,FLAG,FLGN,CSIN,CSIP,CSAN,CSAP,ADATE,IDATE
S U="^"
S CSD=$P($T(ADJDATA+4),";;",2) Q:CSD']"" D
. S FILE=80.2,NODE=$P(CSD,U,2),FLAG=$P(CSD,U,3),FLGN=$P(CSD,U,10)
. S CSIN=$P(CSD,U,4),CSIP=$P(CSD,U,5),CSAN=$P(CSD,U,6)
. S CSAP=$P(CSD,U,7),ADATE=$P(CSD,U,8),IDATE=$P(CSD,U,9),MDC=$P(CSD,U,11),SURG=$P(CSD,U,12)
. S ROOT=^DIC(FILE,0,"GL"),IEN=0
. ;CODE TAKE FROM MAINLOOP
. N DKZ,RC,STAT,IDT,ADT,S,DRGZ S S="////"
. W !!!?5,"UPDATING INACTIVE FLAG FOR ",FILE,!
. F S IEN=$O(@(ROOT_IEN_")")) Q:'+IEN D
. . S DKZ=$G(@(ROOT_IEN_",0)")),STAT=+$P(DKZ,U,FLAG) ; zero node, status
. . S IDT=$P(DKZ,U,CSIP),ADT=$P(DKZ,U,CSAP) ; in/active dates
. . S MDCD=$P(DKZ,U,MDC),SURGD=$P(DKZ,U,SURG) D SETINACT(IEN) Q
Q
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADJDATA ;data to add/update
;;
;;80.1^66^9^102^11^12^12^2781001^2791001^100
;;80^66^9^102^11^16^16^2781001^2791001^100
;;80.2^66^14^16^15^14^13^2821001^2791001^15^5^6
Q
;;81^60^4^7^7^8^8^2890101^2900101^5
;;81.3^60^5^7^7^8^8^2890101^2900101^5
;;
;;
ICD187PT ; ALB/ADL - GROUPER DRIVER ; 04/11/03
+1 ;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 7
+2 ;;**routine to build the new DRG global levels required for the CSV project
+3 ;;**taken from routine created by DEK to add new "66" levels to ICD0 and ICD9
+4 ;;**it addes the "DRG" levels to the 66 multiples in ICD0 (#80.1) and ICD9 (#80) and
+5 ;;**it creates the 66 multiple levels in the DRG file (ICD/#80.2)
+6 NEW I,FILE,CSD,NODE,FLAG,FLGN,CSIN,CSIP,CSAN,CSAP,ADATE,IDATE
+7 SET U="^"
+8 FOR I=2:1
SET CSD=$PIECE($TEXT(ADJDATA+I),";;",2)
IF CSD']""
QUIT
Begin DoDot:1
+9 SET FILE=$PIECE(CSD,U)
SET NODE=$PIECE(CSD,U,2)
SET FLAG=$PIECE(CSD,U,3)
SET FLGN=$PIECE(CSD,U,10)
+10 SET CSIN=$PIECE(CSD,U,4)
SET CSIP=$PIECE(CSD,U,5)
SET CSAN=$PIECE(CSD,U,6)
+11 SET CSAP=$PIECE(CSD,U,7)
SET ADATE=$PIECE(CSD,U,8)
SET IDATE=$PIECE(CSD,U,9)
SET MDC=$PIECE(CSD,U,11)
SET SURG=$PIECE(CSD,U,12)
+12 DO MAINLOOP(^DIC(FILE,0,"GL"),0)
End DoDot:1
+13 QUIT
+14 ;
MAINLOOP(ROOT,IEN) ;
+1 NEW DKZ,RC,STAT,IDT,ADT,S,DRGZ
SET S="////"
+2 WRITE !!!?5,"APPLYING EDITS TO FILE ",FILE,!
+3 ;Remove old "66" levels before inserting new ones into ICD file
IF FILE=80.2
DO CLEANUP
+4 FOR
SET IEN=$ORDER(@(ROOT_IEN_")"))
IF '+IEN
QUIT
Begin DoDot:1
+5 ; zero node, status
SET DKZ=$GET(@(ROOT_IEN_",0)"))
SET STAT=+$PIECE(DKZ,U,FLAG)
+6 ; in/active dates
SET IDT=$PIECE(DKZ,U,CSIP)
SET ADT=$PIECE(DKZ,U,CSAP)
+7 IF FILE<81
Begin DoDot:2
+8 IF FILE=80.2
SET MDCD=$PIECE(DKZ,U,MDC)
SET SURGD=$PIECE(DKZ,U,SURG)
DO ALTERDRG
QUIT
+9 IF FILE=80
SET DRGZ=$GET(@(ROOT_IEN_",""DRG"")"))
+10 IF FILE=80.1
SET DRGZ="^^^^^"
SET SS=$ORDER(@(ROOT_IEN_",""MDC"",99999)"),-1)
IF SS'=""
SET DRGZ=$GET(@(ROOT_IEN_",""MDC"","_SS_",""DRG"")"))
+11 DO ALTERICD
End DoDot:2
QUIT
+12 DO ALTERCPT
End DoDot:1
+13 QUIT
ALTERICD ;
+1 NEW ANS,AD,ID,DR
+2 IF 'STAT
SET AD=$SELECT(IDT="":ADATE,1:IDT)
SET DR=CSAN_S_AD
+3 IF '$TEST
SET ID=$SELECT(IDT="":IDATE,1:IDT)
SET DR=CSIN_S_ID_";"_CSAN_S_ADATE
+4 ;S ANS=$$EDIT0(IEN,ROOT,DR) ;*DON'T RUN TO REBUILD .01 LEVEL
+5 SET ANS=1
+6 ;W !,"IEN ",IEN,$S('ANS:" IN USE",1:" EDITED")
+7 ;
+8 IF 'STAT
DO ADDMULT(FILE,IEN,NODE,AD,1,DRGZ)
+9 IF STAT
DO ADDMULT(FILE,IEN,NODE,ID,0,DRGZ)
+10 QUIT
+11 ;
ALTERDRG ;
+1 NEW ANS,AD,ID,DR,EFFDT,EFFDT2,ACTFLG,FIRSTSET
+2 ;I $D(@(ROOT_IEN_",66)")) Q
+3 ;Default ACTLFG=0 to start
SET FY=0
SET ACTFLG=0
SET FIRSTSET=0
+4 FOR
SET FY=$ORDER(@(ROOT_IEN_",""FY"",FY)"))
IF FY=""
QUIT
SET FYINFO=^(FY,0)
SET WGHT=$PIECE(FYINFO,U,2)
SET UPDT=$SELECT((+WGHT)&('ACTFLG):1,(+WGHT=0)&(ACTFLG):1,1:0)
IF UPDT!('FIRSTSET)
Begin DoDot:1
+5 ;Ignore dates before FY 1983
SET EFFDT=($EXTRACT(FY,1,3)-1)_"1001"
IF EFFDT<2821001
QUIT
+6 ;1st FY date WEIGHT = 0 (INACTIVE) - must have 1st entry = ACTIVE so create one
IF 'FIRSTSET&(+WGHT=0)
Begin DoDot:2
+7 ;add FY 1983 w/status of ACTIVE
SET EFFDT2=2821001
DO ADDDRGZ(FILE,IEN,NODE,EFFDT2,1,MDCD,SURGD)
+8 SET ACTFLG=1
End DoDot:2
+9 SET FIRSTSET=1
+10 ;First FY date = 2830000. Don't add second EFF DT entry for FY 2830000
IF EFFDT=2821001&(ACTFLG)
QUIT
+11 ;add INACTIVE node
IF ACTFLG
DO ADDDRGZ(FILE,IEN,NODE,EFFDT,0,MDCD,SURGD)
SET ACTFLG=0
QUIT
+12 ;add ACTIVE node
IF 'ACTFLG
DO ADDDRGZ(FILE,IEN,NODE,EFFDT,1,MDCD,SURGD)
SET ACTFLG=1
End DoDot:1
+13 QUIT
+14 ;
CLEANUP ;REMOVE 66 LEVELS TO REPROCESS
+1 SET CD=0
+2 FOR
SET CD=$ORDER(^ICD(CD))
IF CD=""
QUIT
KILL ^ICD(CD,66)
+3 ;CLEANUP
QUIT
ALTERCPT ;
+1 NEW DR,AD,ID,ANS,EFF,EFFS
+2 SET EFF=$$EFF(FILE,IEN)
+3 SET EFFS=$PIECE(EFF,U,2)
SET ID=$PIECE(EFF,U,3)
SET AD=$PIECE(EFF,U,4)
SET DR=CSAN_S_AD
+4 IF 'EFFS
SET DR=DR_";"_CSIN_S_ID
+5 IF EFFS'=1-STAT
SET DR=DR_";"_FLGN_S_EFFS
+6 SET ANS=$$EDIT0(IEN,ROOT,DR)
+7 ;W !,"IEN ",IEN,$S('ANS:" IN USE",1:" EDITED")
+8 ;
+9 IF AD=ADATE
DO ADDMULT(FILE,IEN,NODE,AD,1)
+10 IF 'EFFS
IF ID=IDATE
DO ADDMULT(FILE,IEN,NODE,ID,0)
+11 QUIT
+12 ;
EFF(FILE,CODE) ;
+1 NEW EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFBOOL,EFFDOS,EFFDFLT
+2 SET EFFDFLT="2890101^1^2900101^2890101"
SET EFILE=^DIC(FILE,0,"GL")_CODE_",60,"
+3 SET EFF=$ORDER(@(EFILE_"""B"","_(DT+.001)_")"),-1)
IF 'EFF
QUIT EFFDFLT
+4 ; node 60 (effective date) sub-entry
SET EFFN=$ORDER(@(EFILE_"""B"","_EFF_",0)"))
+5 SET STR=$GET(@(EFILE_EFFN_",0)"))
IF 'STR
QUIT EFFDFLT
+6 ;set Opposite eff. date based on status
+7 SET EFFDT=+STR
SET EFFST=$PIECE(STR,U,2)
SET EFFBOOL=0
+8 FOR
SET EFF=$ORDER(@(EFILE_"""B"","_EFF_")"),-1)
IF 'EFF!EFFBOOL
QUIT
Begin DoDot:1
+9 SET EFFN=$ORDER(@(EFILE_"""B"","_EFF_",0)"))
+10 SET EFFDOS=$GET(@(EFILE_EFFN_",0)"))
IF 'EFFDOS
SET EFF=""
QUIT
+11 SET EFFBOOL=(EFFST'=$PIECE(EFFDOS,U,2))
End DoDot:1
+12 SET EFFDOS=$GET(EFFDOS,$SELECT('EFFST:$PIECE(EFFDFLT,U),1:$PIECE(EFFDFLT,U,3)))
+13 IF EFFST
SET $PIECE(STR,U,3,4)=(+EFFDOS)_U_EFFDT
+14 IF '$TEST
SET $PIECE(STR,U,3,4)=EFFDT_U_(+EFFDOS)
+15 QUIT STR
+16 ;
EDIT0(DA,DIE,DR) ; adjust zero node
+1 NEW REC
SET REC=DA
+2 LOCK +@(DIE_REC_",0)"):2
IF $TEST
Begin DoDot:1
+3 DO ^DIE
+4 LOCK -@(DIE_REC_",0)")
End DoDot:1
QUIT 1
+5 QUIT 0
+6 ;
ADDMULT(FN,IEN,NODE,X,STA,DRGZ) ; add to multiple
+1 NEW FDA,FDAIEN,ANS
+2 SET FN=+$PIECE(^DD(FN,NODE,0),U,2)
+3 SET FDAIEN="1,"_IEN_","
+4 KILL ^TMP("DIERR",$JOB)
+5 ;S FDA(FN,FDAIEN,.01)=X ;NOT REQ'D SINCE ICD*18.0*6 ALREADY BUILT THIS LEVEL
+6 ;S FDA(FN,FDAIEN,.02)=STA ;NOT REQ'D SINCE ICD*18.0*6 ALREADY BUILT THIS LEVEL
+7 FOR DRGCNT=1:1:6
SET FDA(FN,FDAIEN,59+DRGCNT)=$PIECE(DRGZ,"^",DRGCNT)
+8 DO UPDATE^DIE("","FDA")
+9 SET ANS='$DATA(^TMP("DIERR",$JOB))
+10 ;W !,"IEN ",IEN,$S('ANS:" DIDNT",1:" DID")," ADD ",STA
+11 QUIT
+12 ;
ADDDRGZ(FN,IEN,NODE,X,STA,MDCD,SURGD) ; add to DRG multiple
+1 NEW FDA,FDAIEN,ANS
+2 SET FN=+$PIECE(^DD(FN,NODE,0),U,2)
+3 SET FDAIEN="+1,"_IEN_","
+4 KILL ^TMP("DIERR",$JOB)
+5 SET FDA(FN,FDAIEN,.01)=X
+6 SET FDA(FN,FDAIEN,.03)=STA
+7 SET FDA(FN,FDAIEN,.05)=MDCD
+8 SET FDA(FN,FDAIEN,.06)=SURGD
+9 ;F DRGCNT=1:1:6 S FDA(FN,FDAIEN,59+DRGCBT)=$P(DRGZ,"^",DRGCNT)
+10 DO UPDATE^DIE("","FDA")
+11 SET ANS='$DATA(^TMP("DIERR",$JOB))
+12 ;W !,"IEN ",IEN,$S('ANS:" DIDNT",1:" DID")," ADD ",STA
+13 QUIT
+14 ;
SETINACT(IEN) ;set inactive dates for DRG codes
+1 NEW FY
+2 SET FY=0
+3 FOR
SET FY=$ORDER(^ICD(IEN,"FY",FY))
IF FY=""
QUIT
IF +$PIECE(^ICD(IEN,"FY",FY,0),"^",2)=0
Begin DoDot:1
+4 SET DATE=$EXTRACT(FY,1,3)_"1001"
+5 IF $DATA(^ICD(IEN,66,"B",DATE))
QUIT
+6 ; add w/date of 10/1 of FY and STATUS of 0 (INACTIVE)
DO ADDDRGZ(FILE,IEN,NODE,DATE,0,MDCD,SURGD)
+7 WRITE !,"UPDATING ",IEN," TO INACTIVE"
End DoDot:1
QUIT
+8 ;SETINACT
QUIT
+9 ;
UPDATE ; SET INACTIVE DRG LEVELS
+1 NEW I,FILE,CSD,NODE,FLAG,FLGN,CSIN,CSIP,CSAN,CSAP,ADATE,IDATE
+2 SET U="^"
+3 SET CSD=$PIECE($TEXT(ADJDATA+4),";;",2)
IF CSD']""
QUIT
Begin DoDot:1
+4 SET FILE=80.2
SET NODE=$PIECE(CSD,U,2)
SET FLAG=$PIECE(CSD,U,3)
SET FLGN=$PIECE(CSD,U,10)
+5 SET CSIN=$PIECE(CSD,U,4)
SET CSIP=$PIECE(CSD,U,5)
SET CSAN=$PIECE(CSD,U,6)
+6 SET CSAP=$PIECE(CSD,U,7)
SET ADATE=$PIECE(CSD,U,8)
SET IDATE=$PIECE(CSD,U,9)
SET MDC=$PIECE(CSD,U,11)
SET SURG=$PIECE(CSD,U,12)
+7 SET ROOT=^DIC(FILE,0,"GL")
SET IEN=0
+8 ;CODE TAKE FROM MAINLOOP
+9 NEW DKZ,RC,STAT,IDT,ADT,S,DRGZ
SET S="////"
+10 WRITE !!!?5,"UPDATING INACTIVE FLAG FOR ",FILE,!
+11 FOR
SET IEN=$ORDER(@(ROOT_IEN_")"))
IF '+IEN
QUIT
Begin DoDot:2
+12 ; zero node, status
SET DKZ=$GET(@(ROOT_IEN_",0)"))
SET STAT=+$PIECE(DKZ,U,FLAG)
+13 ; in/active dates
SET IDT=$PIECE(DKZ,U,CSIP)
SET ADT=$PIECE(DKZ,U,CSAP)
+14 SET MDCD=$PIECE(DKZ,U,MDC)
SET SURGD=$PIECE(DKZ,U,SURG)
DO SETINACT(IEN)
QUIT
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ADJDATA ;data to add/update
+1 ;;
+2 ;;80.1^66^9^102^11^12^12^2781001^2791001^100
+3 ;;80^66^9^102^11^16^16^2781001^2791001^100
+4 ;;80.2^66^14^16^15^14^13^2821001^2791001^15^5^6
+5 QUIT
+6 ;;81^60^4^7^7^8^8^2890101^2900101^5
+7 ;;81.3^60^5^7^7^8^8^2890101^2900101^5
+8 ;;
+9 ;;
