- SDCD ;BSN/GRR - DISCHARGE PATIENT FROM CLINIC ;3/15/91 11:24 ;
- ;;5.3;Scheduling;**41,148**;AUG 13, 1993
- 15 D:'$D(DT) DT^SDUTL I '$G(SDFN) S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:Y=-1 QUIT
- S:$G(SDFN) Y=+SDFN S DA(2)=+Y
- I '$G(SDCLN) G:'$D(^DPT(+Y,"DE")) NOPE S DIC="^DPT("_DA(2)_",""DE"",",DIC("S")="I $P(^(0),""^"",2)']""""",VAUTSTR="clinic",VAUTNI=2,VAUTVB="VAUTC" D FIRST^VAUTOMA K DIC("S") Q:Y<0
- I $G(SDCLN) D G QUIT:'$O(VAUTC(0))
- .S VAUTC=0,VAUTC(+$O(^DPT(DA(2),"DE","B",+SDCLN,99999),-1))=+SDCLN
- .I '$O(VAUTC(0)) W !!,*7,">>> Patient not enrolled in '",$S($D(^SC(+SDCLN,0)):$P(^(0),"^"),1:"Unknown"),"' clinic." S SDAMERR=1
- I VAUTC=1 F I=0:0 S I=$O(^DPT(DA(2),"DE",I)) Q:'I S CLINIC=^DPT(DA(2),"DE",I,0) I $P(CLINIC,U,2)']"" S VAUTC(I)=+CLINIC
- D BEFORE^SCMCEV3(DA(2)) ;setup before values
- F I=0:0 S I=$O(VAUTC(I)) Q:'I S DA(1)=I,SC=VAUTC(I) D DIS
- I '$O(VAUTC(0)) W !!,*7,">>> Patient is not actively enrolled in any clinics." S SDAMERR=1
- I '$D(SDAMERR) D AFTER^SCMCEV3(DA(2)) ;setup after values
- ;call team event driver
- I '$D(SDAMERR) D INVOKE^SCMCEV3(DA(2))
- G 15:'$G(SDFN)
- QUIT ;
- K CLINIC,DFN,SC,SDF,SDST,VAUTC,VAUTD,VAUTNI,VAUSTR,VAUTVB,DIC
- Q
- DIS ;
- S SDF=0
- I $P(^DPT(DA(2),"DE",DA(1),0),"^",2)]"" W *7,*7,!,"PATIENT ALREADY DISCHARGED FROM '",$S($D(^SC(SC,0)):$P(^(0),U),1:"UNKNOWN"),"' CLINIC",*7,*7 S SDAMERR=1 Q
- W !!,"***Discharging patient from ",$S($D(^SC(SC,0)):$P(^(0),U),1:"UNKNOWN")," Clinic***",!
- F XX=DT_.2359:0 S XX=$O(^DPT(DA(2),"S",XX)) Q:XX'>0 I $P(^(XX,0),"^",1)=SC,$P(^(0),"^",2)=""!($P(^(0),"^",2)="I") W !?10,*7,"PATIENT HAS FUTURE APPOINTMENT(S) IN THIS CLINIC" S SDF=1
- I 'SDF F XX=0:0 S XX=$O(^DPT(DA(2),"DE",DA(1),1,XX)) Q:XX="" D STAT I SDST']"" S DIE="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DA=XX,DR="3"_$S($G(SCDISCH):"///"_SCDISCH,1:"")_";I 'X S Y=0;I X S XD=1;4" D ^DIE
- W !,*7,"Patient ",$S('$D(XD):"NOT ",XD=2:"ALREADY ",1:""),"Discharged from clinic !!",! S:SDF SDF=0,SDAMERR=1 K XD
- Q
- NOPE W !,*7,"PATIENT NOT ENROLLED IN ANY CLINICS!!" G QUIT:$G(SDFN),15
- STAT ;ck if already discharged
- S SDST=$P(^DPT(DA(2),"DE",DA(1),1,XX,0),U,3) Q:SDST']""
- S DIE="^DPT("_DA(2)_",""DE"","_DA(1)_",1,",DA=XX,DR="3////^S X=SDST"
- L @(DIE_XX_")"):2 G:'$T STAT D ^DIE L S:'$D(XD) XD=2 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCD 2261 printed Feb 19, 2025@00:15:22 Page 2
- SDCD ;BSN/GRR - DISCHARGE PATIENT FROM CLINIC ;3/15/91 11:24 ;
- +1 ;;5.3;Scheduling;**41,148**;AUG 13, 1993
- 15 if '$DATA(DT)
- DO DT^SDUTL
- IF '$GET(SDFN)
- SET DIC="^DPT("
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y=-1
- GOTO QUIT
- +1 if $GET(SDFN)
- SET Y=+SDFN
- SET DA(2)=+Y
- +2 IF '$GET(SDCLN)
- if '$DATA(^DPT(+Y,"DE"))
- GOTO NOPE
- SET DIC="^DPT("_DA(2)_",""DE"","
- SET DIC("S")="I $P(^(0),""^"",2)']"""""
- SET VAUTSTR="clinic"
- SET VAUTNI=2
- SET VAUTVB="VAUTC"
- DO FIRST^VAUTOMA
- KILL DIC("S")
- if Y<0
- QUIT
- +3 IF $GET(SDCLN)
- Begin DoDot:1
- +4 SET VAUTC=0
- SET VAUTC(+$ORDER(^DPT(DA(2),"DE","B",+SDCLN,99999),-1))=+SDCLN
- +5 IF '$ORDER(VAUTC(0))
- WRITE !!,*7,">>> Patient not enrolled in '",$SELECT($DATA(^SC(+SDCLN,0)):$PIECE(^(0),"^"),1:"Unknown"),"' clinic."
- SET SDAMERR=1
- End DoDot:1
- if '$ORDER(VAUTC(0))
- GOTO QUIT
- +6 IF VAUTC=1
- FOR I=0:0
- SET I=$ORDER(^DPT(DA(2),"DE",I))
- if 'I
- QUIT
- SET CLINIC=^DPT(DA(2),"DE",I,0)
- IF $PIECE(CLINIC,U,2)']""
- SET VAUTC(I)=+CLINIC
- +7 ;setup before values
- DO BEFORE^SCMCEV3(DA(2))
- +8 FOR I=0:0
- SET I=$ORDER(VAUTC(I))
- if 'I
- QUIT
- SET DA(1)=I
- SET SC=VAUTC(I)
- DO DIS
- +9 IF '$ORDER(VAUTC(0))
- WRITE !!,*7,">>> Patient is not actively enrolled in any clinics."
- SET SDAMERR=1
- +10 ;setup after values
- IF '$DATA(SDAMERR)
- DO AFTER^SCMCEV3(DA(2))
- +11 ;call team event driver
- +12 IF '$DATA(SDAMERR)
- DO INVOKE^SCMCEV3(DA(2))
- +13 if '$GET(SDFN)
- GOTO 15
- QUIT ;
- +1 KILL CLINIC,DFN,SC,SDF,SDST,VAUTC,VAUTD,VAUTNI,VAUSTR,VAUTVB,DIC
- +2 QUIT
- DIS ;
- +1 SET SDF=0
- +2 IF $PIECE(^DPT(DA(2),"DE",DA(1),0),"^",2)]""
- WRITE *7,*7,!,"PATIENT ALREADY DISCHARGED FROM '",$SELECT($DATA(^SC(SC,0)):$PIECE(^(0),U),1:"UNKNOWN"),"' CLINIC",*7,*7
- SET SDAMERR=1
- QUIT
- +3 WRITE !!,"***Discharging patient from ",$SELECT($DATA(^SC(SC,0)):$PIECE(^(0),U),1:"UNKNOWN")," Clinic***",!
- +4 FOR XX=DT_.2359:0
- SET XX=$ORDER(^DPT(DA(2),"S",XX))
- if XX'>0
- QUIT
- IF $PIECE(^(XX,0),"^",1)=SC
- IF $PIECE(^(0),"^",2)=""!($PIECE(^(0),"^",2)="I")
- WRITE !?10,*7,"PATIENT HAS FUTURE APPOINTMENT(S) IN THIS CLINIC"
- SET SDF=1
- +5 IF 'SDF
- FOR XX=0:0
- SET XX=$ORDER(^DPT(DA(2),"DE",DA(1),1,XX))
- if XX=""
- QUIT
- DO STAT
- IF SDST']""
- SET DIE="^DPT("_DA(2)_",""DE"","_DA(1)_",1,"
- SET DA=XX
- SET DR="3"_$SELECT($GET(SCDISCH):"///"_SCDISCH,1:"")_";I 'X S Y=0;I X S XD=1;4"
- DO ^DIE
- +6 WRITE !,*7,"Patient ",$SELECT('$DATA(XD):"NOT ",XD=2:"ALREADY ",1:""),"Discharged from clinic !!",!
- if SDF
- SET SDF=0
- SET SDAMERR=1
- KILL XD
- +7 QUIT
- NOPE WRITE !,*7,"PATIENT NOT ENROLLED IN ANY CLINICS!!"
- if $GET(SDFN)
- GOTO QUIT
- GOTO 15
- STAT ;ck if already discharged
- +1 SET SDST=$PIECE(^DPT(DA(2),"DE",DA(1),1,XX,0),U,3)
- if SDST']""
- QUIT
- +2 SET DIE="^DPT("_DA(2)_",""DE"","_DA(1)_",1,"
- SET DA=XX
- SET DR="3////^S X=SDST"
- +3 LOCK @(DIE_XX_")"):2
- if '$TEST
- GOTO STAT
- DO ^DIE
- LOCK
- if '$DATA(XD)
- SET XD=2
- QUIT