- 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 Feb 19, 2025@00:25:22 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