SDNACT ;ALB/TMP - INACTIVATE A CLINIC ;Mar 25, 2021@15:05:56
 ;;5.3;Scheduling;**63,380,549,568,622,627,726,781**;Aug 13, 1993;Build 11
 S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL
 S SDAY="Sun^Mon^Tues^Wednes^Thurs^Fri^Satur",SDZQ=1
 D DT^DICRW S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC NAME: ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
 D TURNON^DIAUTL(44,".01;8;2502;2503;2505;2506")
 D ^DIC K DIC("A"),DIC("S") G:Y<0 END S SC=+Y,SDX="",SDX1=9999999
 N SDRES S SDRES=$$CLNCK^SDUTL2(SC,0)
 I 'SDRES D
 .W !,?5,"WARNING:     Clinic's Stop Code ",$P(SDRES,U,2)
 .W !,?5,"Recommend:   Clinic be corrected."
 I $D(^SC(SC,"I")),+^("I")'=0,+^("I")'>DT,+$P(^("I"),"^",2)'>0 W *7,!,"This clinic was inactivated effective: " S Y=+^("I") D DTS^SDUTL W Y G END
 I $D(^SC(SC,"I")),+^("I")>DT G CHECK
 I $D(^SC(SC,"I")),+^("I")'>DT,+$P(^("I"),"^",2)'<DT W !,*7,"Clinic is already inactive until " S Y=+$P(^("I"),"^",2) D DTS^SDUTL W Y G END
D S %DT="AEFX",%DT("A")="Enter Date Clinic is to be Inactivated: " D ^%DT K %DT G:Y'>0 END S SDDATE=Y I Y<DT W "??",!,*7,"Inactivate date must be greater than or equal to today's date" G D
 I SDX<9999999,Y>SDX1,SDX1 W "??",!,*7,"Inactivate date must be < reactivate date" G D
 S POP=0 F I=SDDATE-.0001:0 S I=$O(^SC(SC,"S",I)) Q:'I!(POP)!(SDDATE'<SDX1&(SDX1))  F I1=0:0 S I1=$O(^SC(SC,"S",I,1,I1)) Q:'I1  I $P(^(I1,0),"^",9)'="C" S POP=1 Q
 I POP W *7,!,"Can't inactivate the clinic - appointments exist beyond " S Y=SDDATE D DT^DIQ G END
 I SDX'="" D CHG1 G OVR
 K SDN S ^SC(SC,"I")="",X=SDDATE D DOW^SDM0 S SDN(Y)=SDDATE F I=1:1:6 S X2=1,X1=X D C^%DTC,DOW^SDM0 S SDN(Y)=X
 F I=0:1:6 S J=$O(^SC(SC,"T"_I,SDN(I))) D GOT
OVR F I=SDDATE-.0001:0 S I=$O(^SC(SC,"ST",I)) Q:'I!(I>SDX1)  K ^(I)
 F I=SDDATE-.0001:0 S I=$O(^SC(SC,"T",I)) Q:'I!(I>SDX1)  K ^(I)
 F I=SDDATE-.0001:0 S I=$O(^SC(SC,"OST",I)) Q:'I!(I>SDX1)  K ^(I)
 S DIE="^SC(",DA=SC,DR="2505///^S X=SDDATE" D ^DIE  ;SD*549 use FM API to update field so Audit Trail functions properly
 D SDEC(SC,SDDATE)  ;alb/sat 627
 W !!,"Clinic will be inactivated effective " N SDDT S Y=SDDATE D DTS^SDUTL W Y S SDDT=Y D QUE G END ; SD*5.3*622 - call mail delivery
 ;
CHECK W *7,!,"This clinic is to be inactivated as of " S SDX=+^("I"),Y=SDX D DTS^SDUTL W Y S SDX1=+$P(^("I"),"^",2),Y=SDX1 I Y D DTS^SDUTL W " and reactivated as of ",Y ;NAKED REFERENCE - ^SC(DFN,"I")
 S %=1 W !,"Do you want to change the inactivate date" D YN^DICN I '% W !,"RESPOND YES OR NO" G CHECK
 G D:'(%-1),END:(%<0),DEL
 ;
DEL S %=2 W !,"Do you want to delete the inactivate date" D YN^DICN I '% W !,"RESPOND YES (Y) OR NO (N)" G DEL
 G:(%-1) END
 I '$D(^SC(SC,"SL")) W !,*7,"Cannot Delete - 'SL' node doesn't exist" G END
 G ^SDNACT1
CHG1 K SDN S X1=SDDATE,X2=6 D C^%DTC S SDNL=X,X=SDDATE D DOW^SDM0 S SDN(Y)=X
 F I=1:1:6 S X1=X,X2=1 D C^%DTC,DOW^SDM0 S SDN(Y)=X
 S X1=SDX,X2=6 D C^%DTC S SDOL=X,X1=SDX,X2=-1 D C^%DTC
 F I=0:0 S X2=1,X1=X D C^%DTC Q:X>SDOL  D DOW^SDM0 S:$D(^SC(SC,"T"_Y))&($O(^SC(SC,"T"_Y,0))'=9999999) ^SC(SC,"T"_Y,SDN(Y),1)=$S($D(^SC(SC,"T"_Y,X,1)):^(1),1:""),^(0)=SDN(Y) D A1,A
 I SDDATE<SDX F I=0:1:6 F J=SDNL:0 S J=$O(^SC(SC,"T"_I,J)) Q:'J!(J'<SDX)  K ^SC(SC,"T"_I,J)
 Q
A1 S:'$D(^SC(SC,"T"_Y,9999999,1)) ^(1)="",^(0)=9999999 K:(SDN(Y)-X) ^SC(SC,"T"_Y,X)
 Q
A I $O(^SC(SC,"T"_Y,SDN(Y)))>0 S SD=$O(^SC(SC,"T"_Y,SDN(Y))) S:^SC(SC,"T"_Y,SD,1)]"" ^SC(SC,"T"_Y,SDN(Y),1)=^SC(SC,"T"_Y,SD,1),^(0)=SDN(Y),^SC(SC,"T"_Y,SD,1)=""
 I SDX'>SDDATE,$O(^SC(SC,"ST",SDX-.1))>0 F Z=SDX-.1:0 S Z=$O(^SC(SC,"ST",Z)) Q:'Z!(SDX1&(Z'<SDX1))  K ^SC(SC,"ST",Z)
 K SD,Z Q
GOT S SD=$O(^SC(SC,"T"_I,0))
 I J>0,SD'=9999999,^SC(SC,"T"_I,J,1)'="" S ^SC(SC,"T"_I,SDN(I),1)=^SC(SC,"T"_I,J,1),^(0)=SDN(I) K ^SC(SC,"T"_I,J) F J1=J:0 S J1=$O(^SC(SC,"T"_I,J1)) Q:'J1  K ^SC(SC,"T"_I,J1) ;don't remove if already canceled, SD*5.3*726
 S ^SC(SC,"T"_I,9999999,1)="",^(0)=9999999
 Q
END K A,DA,CNT,D0,DH,DO,DOW,I,I1,J,J1,POP,SC,SD,SD0,SDAY,SDEL,SDDATE,SDFSW,SDN,SDNL,SDOL,SDREACT,SI,SL,STARTDAY,SDX,SDX1,SDZQ,X,X1,X2,Y,Z,DIE,DR,DIC Q
 ;
MAIL ; SD*5.3*622 - send bulletin to advise of clinic inactivation date
 N SDNAME,SDMYARR,SDTEXT,XMDUZ,XMSUB,XMTEXT,XMY
 S XMSUB="CLINIC INACTIVATED"
 S XMY("G.SD CLINIC INACTIVATE REMINDER")=""
 S XMDUZ=.5
 S XMY(DUZ)="",XMY(XMDUZ)=""
 S SDMYARR("FILE")=200
 S SDMYARR("FIELD")=.01
 S SDMYARR("IENS")=DUZ
 S SDNAME=$$BLDNAME^XLFNAME(.SDMYARR) ; covered by IA #3065
 ;
 S SDTEXT(1)="CLINIC NAME:   "_$$GET1^DIQ(44,+SC,.01,"E")
 S SDTEXT(2)="INACTIVATION DATE:   "_SDDT
 S SDTEXT(3)=" "
 S SDTEXT(4)="Clinic inactivated by "_SDNAME_" on "_SDDT
 S SDTEXT(5)=" "
 S SDTEXT(6)="Please perform the following steps immediately:"
 S SDTEXT(7)=" "
 S SDTEXT(8)="1. Add at least 2 Z's (UPPERCASE) in front of the clinic name"
 S SDTEXT(9)="2. Validate that the Clinic Scheduling Grid has been removed"
 S SDTEXT(10)=" "
 S XMTEXT="SDTEXT("
 D ^XMD
 Q
 ;
QUE ; leave job to TaskMan for dates in the future, otherwise deliver
 ; message immediately for an inactivation date equal to the current
 ; date
 N SDDTH,SDTQ,Y,ZTRTN,ZTIO,ZTSAVE,ZTDESC,ZTDTH
 S SDTQ=DT
 I $D(^SC(SC,"I")) D
 . S SDDT=$P(^SC(+SC,"I"),"^",1)
 . I SDDT=SDTQ S Y=DT D DTS^SDUTL S SDDT=Y D MAIL Q
 . I SDDT<SDTQ Q  ; don't care for dates on the past
 . I SDDT>SDTQ D
 .. S SDDTH=$$FMTH^XLFDT(SDDT+.0100) ; queue at 1 am on desired date
 .. S ZTDTH=SDDTH
 .. S Y=SDDT D DTS^SDUTL S SDDT=Y
 .. S ZTDESC="CLINIC INACTIVATION REMINDER QUEUE"
 .. S ZTRTN="QUE^SDNACT"
 .. S ZTIO="NULL"
 .. S ZTSAVE("*")=""
 .. D ^%ZTLOAD
 Q  ; SD*5.3*622 - end of changes
 ;
SDEC(SC,SDDATE) ;update INACTIVATED DATE/TIME in SDEC RESOURCE   ;alb/sat 627
 N SDFDA,SDI,SDJ,SDRES,SDREACT
 S SDRES=$$GETRES^SDECUTL(SC,1) ;lab 781 need, "1" sent to assign resource
 Q:SDRES=""
 ;lab 781 - if inactivated date greater than existing 
 S SDREACT=$$GET1^DIQ(409.831,SDRES_",",.025,"I")
 S SDFDA(409.831,SDRES_",",.021)=SDDATE
 S SDFDA(409.831,SDRES_",",.022)=DUZ
 I SDREACT<DT D
 . S SDFDA(409.831,SDRES_",",.025)="@"
 . S SDFDA(409.831,SDRES_",",.026)="@"
 D FILE^DIE("","SDFDA")
 K SDFDA
 ;update SDEC RESOURCE GROUP file
 S SDI="" F  S SDI=$O(^SDEC(409.832,"AB",SDRES,SDI)) Q:SDI=""  D
 .S SDJ="" F  S SDJ=$O(^SDEC(409.832,"AB",SDRES,SDI,SDJ)) Q:SDJ=""  D
 ..K SDFDA
 ..S SDFDA(409.8321,SDJ_","_SDI_",",.01)="@"
 ..D FILE^DIE("","SDFDA")
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDNACT   6377     printed  Sep 23, 2025@20:35:41                                                                                                                                                                                                      Page 2
SDNACT    ;ALB/TMP - INACTIVATE A CLINIC ;Mar 25, 2021@15:05:56
 +1       ;;5.3;Scheduling;**63,380,549,568,622,627,726,781**;Aug 13, 1993;Build 11
 +2        if '$DATA(DTIME)
               SET DTIME=300
           IF '$DATA(DT)
               DO DT^SDUTL
 +3        SET SDAY="Sun^Mon^Tues^Wednes^Thurs^Fri^Satur"
           SET SDZQ=1
 +4        DO DT^DICRW
           SET DIC="^SC("
           SET DIC(0)="AEMZQ"
           SET DIC("A")="Select CLINIC NAME: "
           SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
 +5        DO TURNON^DIAUTL(44,".01;8;2502;2503;2505;2506")
 +6        DO ^DIC
           KILL DIC("A"),DIC("S")
           if Y<0
               GOTO END
           SET SC=+Y
           SET SDX=""
           SET SDX1=9999999
 +7        NEW SDRES
           SET SDRES=$$CLNCK^SDUTL2(SC,0)
 +8        IF 'SDRES
               Begin DoDot:1
 +9                WRITE !,?5,"WARNING:     Clinic's Stop Code ",$PIECE(SDRES,U,2)
 +10               WRITE !,?5,"Recommend:   Clinic be corrected."
               End DoDot:1
 +11       IF $DATA(^SC(SC,"I"))
               IF +^("I")'=0
                   IF +^("I")'>DT
                       IF +$PIECE(^("I"),"^",2)'>0
                           WRITE *7,!,"This clinic was inactivated effective: "
                           SET Y=+^("I")
                           DO DTS^SDUTL
                           WRITE Y
                           GOTO END
 +12       IF $DATA(^SC(SC,"I"))
               IF +^("I")>DT
                   GOTO CHECK
 +13       IF $DATA(^SC(SC,"I"))
               IF +^("I")'>DT
                   IF +$PIECE(^("I"),"^",2)'<DT
                       WRITE !,*7,"Clinic is already inactive until "
                       SET Y=+$PIECE(^("I"),"^",2)
                       DO DTS^SDUTL
                       WRITE Y
                       GOTO END
D          SET %DT="AEFX"
           SET %DT("A")="Enter Date Clinic is to be Inactivated: "
           DO ^%DT
           KILL %DT
           if Y'>0
               GOTO END
           SET SDDATE=Y
           IF Y<DT
               WRITE "??",!,*7,"Inactivate date must be greater than or equal to today's date"
               GOTO D
 +1        IF SDX<9999999
               IF Y>SDX1
                   IF SDX1
                       WRITE "??",!,*7,"Inactivate date must be < reactivate date"
                       GOTO D
 +2        SET POP=0
           FOR I=SDDATE-.0001:0
               SET I=$ORDER(^SC(SC,"S",I))
               if 'I!(POP)!(SDDATE'<SDX1&(SDX1))
                   QUIT 
               FOR I1=0:0
                   SET I1=$ORDER(^SC(SC,"S",I,1,I1))
                   if 'I1
                       QUIT 
                   IF $PIECE(^(I1,0),"^",9)'="C"
                       SET POP=1
                       QUIT 
 +3        IF POP
               WRITE *7,!,"Can't inactivate the clinic - appointments exist beyond "
               SET Y=SDDATE
               DO DT^DIQ
               GOTO END
 +4        IF SDX'=""
               DO CHG1
               GOTO OVR
 +5        KILL SDN
           SET ^SC(SC,"I")=""
           SET X=SDDATE
           DO DOW^SDM0
           SET SDN(Y)=SDDATE
           FOR I=1:1:6
               SET X2=1
               SET X1=X
               DO C^%DTC
               DO DOW^SDM0
               SET SDN(Y)=X
 +6        FOR I=0:1:6
               SET J=$ORDER(^SC(SC,"T"_I,SDN(I)))
               DO GOT
OVR        FOR I=SDDATE-.0001:0
               SET I=$ORDER(^SC(SC,"ST",I))
               if 'I!(I>SDX1)
                   QUIT 
               KILL ^(I)
 +1        FOR I=SDDATE-.0001:0
               SET I=$ORDER(^SC(SC,"T",I))
               if 'I!(I>SDX1)
                   QUIT 
               KILL ^(I)
 +2        FOR I=SDDATE-.0001:0
               SET I=$ORDER(^SC(SC,"OST",I))
               if 'I!(I>SDX1)
                   QUIT 
               KILL ^(I)
 +3       ;SD*549 use FM API to update field so Audit Trail functions properly
           SET DIE="^SC("
           SET DA=SC
           SET DR="2505///^S X=SDDATE"
           DO ^DIE
 +4       ;alb/sat 627
           DO SDEC(SC,SDDATE)
 +5       ; SD*5.3*622 - call mail delivery
           WRITE !!,"Clinic will be inactivated effective "
           NEW SDDT
           SET Y=SDDATE
           DO DTS^SDUTL
           WRITE Y
           SET SDDT=Y
           DO QUE
           GOTO END
 +6       ;
CHECK     ;NAKED REFERENCE - ^SC(DFN,"I")
           WRITE *7,!,"This clinic is to be inactivated as of "
           SET SDX=+^("I")
           SET Y=SDX
           DO DTS^SDUTL
           WRITE Y
           SET SDX1=+$PIECE(^("I"),"^",2)
           SET Y=SDX1
           IF Y
               DO DTS^SDUTL
               WRITE " and reactivated as of ",Y
 +1        SET %=1
           WRITE !,"Do you want to change the inactivate date"
           DO YN^DICN
           IF '%
               WRITE !,"RESPOND YES OR NO"
               GOTO CHECK
 +2        if '(%-1)
               GOTO D
           if (%<0)
               GOTO END
           GOTO DEL
 +3       ;
DEL        SET %=2
           WRITE !,"Do you want to delete the inactivate date"
           DO YN^DICN
           IF '%
               WRITE !,"RESPOND YES (Y) OR NO (N)"
               GOTO DEL
 +1        if (%-1)
               GOTO END
 +2        IF '$DATA(^SC(SC,"SL"))
               WRITE !,*7,"Cannot Delete - 'SL' node doesn't exist"
               GOTO END
 +3        GOTO ^SDNACT1
CHG1       KILL SDN
           SET X1=SDDATE
           SET X2=6
           DO C^%DTC
           SET SDNL=X
           SET X=SDDATE
           DO DOW^SDM0
           SET SDN(Y)=X
 +1        FOR I=1:1:6
               SET X1=X
               SET X2=1
               DO C^%DTC
               DO DOW^SDM0
               SET SDN(Y)=X
 +2        SET X1=SDX
           SET X2=6
           DO C^%DTC
           SET SDOL=X
           SET X1=SDX
           SET X2=-1
           DO C^%DTC
 +3        FOR I=0:0
               SET X2=1
               SET X1=X
               DO C^%DTC
               if X>SDOL
                   QUIT 
               DO DOW^SDM0
               if $DATA(^SC(SC,"T"_Y))&($ORDER(^SC(SC,"T"_Y,0))'=9999999)
                   SET ^SC(SC,"T"_Y,SDN(Y),1)=$SELECT($DATA(^SC(SC,"T"_Y,X,1)):^(1),1:"")
                   SET ^(0)=SDN(Y)
               DO A1
               DO A
 +4        IF SDDATE<SDX
               FOR I=0:1:6
                   FOR J=SDNL:0
                       SET J=$ORDER(^SC(SC,"T"_I,J))
                       if 'J!(J'<SDX)
                           QUIT 
                       KILL ^SC(SC,"T"_I,J)
 +5        QUIT 
A1         if '$DATA(^SC(SC,"T"_Y,9999999,1))
               SET ^(1)=""
               SET ^(0)=9999999
           if (SDN(Y)-X)
               KILL ^SC(SC,"T"_Y,X)
 +1        QUIT 
A          IF $ORDER(^SC(SC,"T"_Y,SDN(Y)))>0
               SET SD=$ORDER(^SC(SC,"T"_Y,SDN(Y)))
               if ^SC(SC,"T"_Y,SD,1)]""
                   SET ^SC(SC,"T"_Y,SDN(Y),1)=^SC(SC,"T"_Y,SD,1)
                   SET ^(0)=SDN(Y)
                   SET ^SC(SC,"T"_Y,SD,1)=""
 +1        IF SDX'>SDDATE
               IF $ORDER(^SC(SC,"ST",SDX-.1))>0
                   FOR Z=SDX-.1:0
                       SET Z=$ORDER(^SC(SC,"ST",Z))
                       if 'Z!(SDX1&(Z'<SDX1))
                           QUIT 
                       KILL ^SC(SC,"ST",Z)
 +2        KILL SD,Z
           QUIT 
GOT        SET SD=$ORDER(^SC(SC,"T"_I,0))
 +1       ;don't remove if already canceled, SD*5.3*726
           IF J>0
               IF SD'=9999999
                   IF ^SC(SC,"T"_I,J,1)'=""
                       SET ^SC(SC,"T"_I,SDN(I),1)=^SC(SC,"T"_I,J,1)
                       SET ^(0)=SDN(I)
                       KILL ^SC(SC,"T"_I,J)
                       FOR J1=J:0
                           SET J1=$ORDER(^SC(SC,"T"_I,J1))
                           if 'J1
                               QUIT 
                           KILL ^SC(SC,"T"_I,J1)
 +2        SET ^SC(SC,"T"_I,9999999,1)=""
           SET ^(0)=9999999
 +3        QUIT 
END        KILL A,DA,CNT,D0,DH,DO,DOW,I,I1,J,J1,POP,SC,SD,SD0,SDAY,SDEL,SDDATE,SDFSW,SDN,SDNL,SDOL,SDREACT,SI,SL,STARTDAY,SDX,SDX1,SDZQ,X,X1,X2,Y,Z,DIE,DR,DIC
           QUIT 
 +1       ;
MAIL      ; SD*5.3*622 - send bulletin to advise of clinic inactivation date
 +1        NEW SDNAME,SDMYARR,SDTEXT,XMDUZ,XMSUB,XMTEXT,XMY
 +2        SET XMSUB="CLINIC INACTIVATED"
 +3        SET XMY("G.SD CLINIC INACTIVATE REMINDER")=""
 +4        SET XMDUZ=.5
 +5        SET XMY(DUZ)=""
           SET XMY(XMDUZ)=""
 +6        SET SDMYARR("FILE")=200
 +7        SET SDMYARR("FIELD")=.01
 +8        SET SDMYARR("IENS")=DUZ
 +9       ; covered by IA #3065
           SET SDNAME=$$BLDNAME^XLFNAME(.SDMYARR)
 +10      ;
 +11       SET SDTEXT(1)="CLINIC NAME:   "_$$GET1^DIQ(44,+SC,.01,"E")
 +12       SET SDTEXT(2)="INACTIVATION DATE:   "_SDDT
 +13       SET SDTEXT(3)=" "
 +14       SET SDTEXT(4)="Clinic inactivated by "_SDNAME_" on "_SDDT
 +15       SET SDTEXT(5)=" "
 +16       SET SDTEXT(6)="Please perform the following steps immediately:"
 +17       SET SDTEXT(7)=" "
 +18       SET SDTEXT(8)="1. Add at least 2 Z's (UPPERCASE) in front of the clinic name"
 +19       SET SDTEXT(9)="2. Validate that the Clinic Scheduling Grid has been removed"
 +20       SET SDTEXT(10)=" "
 +21       SET XMTEXT="SDTEXT("
 +22       DO ^XMD
 +23       QUIT 
 +24      ;
QUE       ; leave job to TaskMan for dates in the future, otherwise deliver
 +1       ; message immediately for an inactivation date equal to the current
 +2       ; date
 +3        NEW SDDTH,SDTQ,Y,ZTRTN,ZTIO,ZTSAVE,ZTDESC,ZTDTH
 +4        SET SDTQ=DT
 +5        IF $DATA(^SC(SC,"I"))
               Begin DoDot:1
 +6                SET SDDT=$PIECE(^SC(+SC,"I"),"^",1)
 +7                IF SDDT=SDTQ
                       SET Y=DT
                       DO DTS^SDUTL
                       SET SDDT=Y
                       DO MAIL
                       QUIT 
 +8       ; don't care for dates on the past
                   IF SDDT<SDTQ
                       QUIT 
 +9                IF SDDT>SDTQ
                       Begin DoDot:2
 +10      ; queue at 1 am on desired date
                           SET SDDTH=$$FMTH^XLFDT(SDDT+.0100)
 +11                       SET ZTDTH=SDDTH
 +12                       SET Y=SDDT
                           DO DTS^SDUTL
                           SET SDDT=Y
 +13                       SET ZTDESC="CLINIC INACTIVATION REMINDER QUEUE"
 +14                       SET ZTRTN="QUE^SDNACT"
 +15                       SET ZTIO="NULL"
 +16                       SET ZTSAVE("*")=""
 +17                       DO ^%ZTLOAD
                       End DoDot:2
               End DoDot:1
 +18      ; SD*5.3*622 - end of changes
           QUIT 
 +19      ;
SDEC(SC,SDDATE) ;update INACTIVATED DATE/TIME in SDEC RESOURCE   ;alb/sat 627
 +1        NEW SDFDA,SDI,SDJ,SDRES,SDREACT
 +2       ;lab 781 need, "1" sent to assign resource
           SET SDRES=$$GETRES^SDECUTL(SC,1)
 +3        if SDRES=""
               QUIT 
 +4       ;lab 781 - if inactivated date greater than existing 
 +5        SET SDREACT=$$GET1^DIQ(409.831,SDRES_",",.025,"I")
 +6        SET SDFDA(409.831,SDRES_",",.021)=SDDATE
 +7        SET SDFDA(409.831,SDRES_",",.022)=DUZ
 +8        IF SDREACT<DT
               Begin DoDot:1
 +9                SET SDFDA(409.831,SDRES_",",.025)="@"
 +10               SET SDFDA(409.831,SDRES_",",.026)="@"
               End DoDot:1
 +11       DO FILE^DIE("","SDFDA")
 +12       KILL SDFDA
 +13      ;update SDEC RESOURCE GROUP file
 +14       SET SDI=""
           FOR 
               SET SDI=$ORDER(^SDEC(409.832,"AB",SDRES,SDI))
               if SDI=""
                   QUIT 
               Begin DoDot:1
 +15               SET SDJ=""
                   FOR 
                       SET SDJ=$ORDER(^SDEC(409.832,"AB",SDRES,SDI,SDJ))
                       if SDJ=""
                           QUIT 
                       Begin DoDot:2
 +16                       KILL SDFDA
 +17                       SET SDFDA(409.8321,SDJ_","_SDI_",",.01)="@"
 +18                       DO FILE^DIE("","SDFDA")
                       End DoDot:2
               End DoDot:1
 +19       QUIT