SCDDI1 ;ALB/SCK/JLU - DD Calls used by Incomplete Encounter Management ; 6/6/97
;;5.3;Scheduling;**66**;AUG 13, 1993
Q
SETAEDT(DA,X) ;
Q:'$G(DA)!('$G(X))
N SDT,SDTD,SDX
S (SDT,SDTD)=""
S SDT=$P($G(^SD(409.73,X,0)),"^",2)
I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
Q:'SDT&('SDTD)
I SDT S SDT=$P($G(^SCE(SDT,0)),"^")
I SDTD S SDT=$P($G(^SD(409.74,SDTD,0)),"^")
S:SDT ^SD(409.75,"AEDT",SDT,X,DA)=""
Q
;
KILAEDT(DA,X) ;
Q:'$G(DA)!('$G(X))
N SDT,SDTD,SDX
S (SDT,SDTD)=""
S SDT=$P($G(^SD(409.73,X,0)),"^",2)
I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
Q:'SDT&('SDTD)
I SDT S SDT=$P($G(^SCE(SDT,0)),"^")
I SDTD S SDT=$P($G(^SD(409.74,SDTD,0)),"^")
K:SDT ^SD(409.75,"AEDT",SDT,X,DA)
Q
;
SETAECL(DA,X) ;
Q:'$G(DA)!('$G(X))
N SDCL,SDX,SDT,SDTD
S (SDCL,SDT,SDTD)=""
S SDT=$P($G(^SD(409.73,X,0)),"^",2)
I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
Q:'SDT&('SDTD)
I SDT S SDCL=$P($G(^SCE(SDT,0)),"^",4)
I SDTD S SDCL=$P($G(^SD(409.74,SDTD,1)),"^",4)
Q:'SDCL
S:SDCL ^SD(409.75,"AECL",SDCL,DA)=""
Q
;
KILAECL(DA,X) ;
Q:'$G(DA)!('$G(X))
N SDT,SDTD,SDCL
S (SDT,SDTD,SDCL)=""
S SDT=$P($G(^SD(409.73,X,0)),"^",2)
I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
Q:'SDT&('SDTD)
I SDT S SDCL=$P($G(^SCE(SDT,0)),"^",4)
I SDTD S SDCL=$P($G(^SD(409.74,SDTD,1)),"^",4)
Q:'SDCL
K ^SD(409.75,"AECL",SDCL,DA)
Q
;
SETACOD1(DA,X) ;
Q:'$G(DA)!('$G(X))
N DFN,COD
S COD=$P(^SD(409.75,DA,0),U,2)
I COD']"" Q
S COD=$P($G(^SD(409.76,COD,0)),U,1)
I COD']"" Q
S DFN=$P(^SD(409.75,DA,0),U,1)
I 'DFN Q
D PATDFN^SCDXUTL2(DFN)
I 'DFN Q
S ^SD(409.75,"ACOD",DFN,COD,DA)=""
Q
;
KILACOD1(DA,X) ;
Q:'$G(DA)!('$G(X))
N DFN,COD
S COD=$P(^SD(409.75,DA,0),U,2)
I COD']"" Q
S COD=$P($G(^SD(409.76,COD,0)),U,1)
I COD']"" Q
S DFN=$P(^SD(409.75,DA,0),U,1)
I 'DFN Q
D PATDFN^SCDXUTL2(DFN)
I 'DFN Q
K ^SD(409.75,"ACOD",DFN,COD,DA)
Q
;
SETACOD2(DA,X) ;
Q:'$G(DA)!('$G(X))
N DFN,COD
S DFN=$P(^SD(409.75,DA,0),U,1)
I 'DFN Q
D PATDFN^SCDXUTL2(DFN)
I 'DFN Q
S COD=$P($G(^SD(409.76,$E(X,1,30),0)),U,1)
I COD']"" Q
S ^SD(409.75,"ACOD",DFN,COD,DA)=""
Q
;
KILACOD2(DA,X) ;
Q:'$G(DA)!('$G(X))
N DFN,COD
S DFN=$P(^SD(409.75,DA,0),U,1)
I 'DFN Q
D PATDFN^SCDXUTL2(DFN)
I 'DFN Q
S COD=$P($G(^SD(409.76,$E(X,1,30),0)),U,1)
I COD']"" Q
K ^SD(409.75,"ACOD",DFN,COD,DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDDI1 2391 printed Oct 16, 2024@18:39:43 Page 2
SCDDI1 ;ALB/SCK/JLU - DD Calls used by Incomplete Encounter Management ; 6/6/97
+1 ;;5.3;Scheduling;**66**;AUG 13, 1993
+2 QUIT
SETAEDT(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW SDT,SDTD,SDX
+3 SET (SDT,SDTD)=""
+4 SET SDT=$PIECE($GET(^SD(409.73,X,0)),"^",2)
+5 IF 'SDT
SET SDTD=$PIECE($GET(^SD(409.73,X,0)),"^",3)
+6 if 'SDT&('SDTD)
QUIT
+7 IF SDT
SET SDT=$PIECE($GET(^SCE(SDT,0)),"^")
+8 IF SDTD
SET SDT=$PIECE($GET(^SD(409.74,SDTD,0)),"^")
+9 if SDT
SET ^SD(409.75,"AEDT",SDT,X,DA)=""
+10 QUIT
+11 ;
KILAEDT(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW SDT,SDTD,SDX
+3 SET (SDT,SDTD)=""
+4 SET SDT=$PIECE($GET(^SD(409.73,X,0)),"^",2)
+5 IF 'SDT
SET SDTD=$PIECE($GET(^SD(409.73,X,0)),"^",3)
+6 if 'SDT&('SDTD)
QUIT
+7 IF SDT
SET SDT=$PIECE($GET(^SCE(SDT,0)),"^")
+8 IF SDTD
SET SDT=$PIECE($GET(^SD(409.74,SDTD,0)),"^")
+9 if SDT
KILL ^SD(409.75,"AEDT",SDT,X,DA)
+10 QUIT
+11 ;
SETAECL(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW SDCL,SDX,SDT,SDTD
+3 SET (SDCL,SDT,SDTD)=""
+4 SET SDT=$PIECE($GET(^SD(409.73,X,0)),"^",2)
+5 IF 'SDT
SET SDTD=$PIECE($GET(^SD(409.73,X,0)),"^",3)
+6 if 'SDT&('SDTD)
QUIT
+7 IF SDT
SET SDCL=$PIECE($GET(^SCE(SDT,0)),"^",4)
+8 IF SDTD
SET SDCL=$PIECE($GET(^SD(409.74,SDTD,1)),"^",4)
+9 if 'SDCL
QUIT
+10 if SDCL
SET ^SD(409.75,"AECL",SDCL,DA)=""
+11 QUIT
+12 ;
KILAECL(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW SDT,SDTD,SDCL
+3 SET (SDT,SDTD,SDCL)=""
+4 SET SDT=$PIECE($GET(^SD(409.73,X,0)),"^",2)
+5 IF 'SDT
SET SDTD=$PIECE($GET(^SD(409.73,X,0)),"^",3)
+6 if 'SDT&('SDTD)
QUIT
+7 IF SDT
SET SDCL=$PIECE($GET(^SCE(SDT,0)),"^",4)
+8 IF SDTD
SET SDCL=$PIECE($GET(^SD(409.74,SDTD,1)),"^",4)
+9 if 'SDCL
QUIT
+10 KILL ^SD(409.75,"AECL",SDCL,DA)
+11 QUIT
+12 ;
SETACOD1(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW DFN,COD
+3 SET COD=$PIECE(^SD(409.75,DA,0),U,2)
+4 IF COD']""
QUIT
+5 SET COD=$PIECE($GET(^SD(409.76,COD,0)),U,1)
+6 IF COD']""
QUIT
+7 SET DFN=$PIECE(^SD(409.75,DA,0),U,1)
+8 IF 'DFN
QUIT
+9 DO PATDFN^SCDXUTL2(DFN)
+10 IF 'DFN
QUIT
+11 SET ^SD(409.75,"ACOD",DFN,COD,DA)=""
+12 QUIT
+13 ;
KILACOD1(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW DFN,COD
+3 SET COD=$PIECE(^SD(409.75,DA,0),U,2)
+4 IF COD']""
QUIT
+5 SET COD=$PIECE($GET(^SD(409.76,COD,0)),U,1)
+6 IF COD']""
QUIT
+7 SET DFN=$PIECE(^SD(409.75,DA,0),U,1)
+8 IF 'DFN
QUIT
+9 DO PATDFN^SCDXUTL2(DFN)
+10 IF 'DFN
QUIT
+11 KILL ^SD(409.75,"ACOD",DFN,COD,DA)
+12 QUIT
+13 ;
SETACOD2(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW DFN,COD
+3 SET DFN=$PIECE(^SD(409.75,DA,0),U,1)
+4 IF 'DFN
QUIT
+5 DO PATDFN^SCDXUTL2(DFN)
+6 IF 'DFN
QUIT
+7 SET COD=$PIECE($GET(^SD(409.76,$EXTRACT(X,1,30),0)),U,1)
+8 IF COD']""
QUIT
+9 SET ^SD(409.75,"ACOD",DFN,COD,DA)=""
+10 QUIT
+11 ;
KILACOD2(DA,X) ;
+1 if '$GET(DA)!('$GET(X))
QUIT
+2 NEW DFN,COD
+3 SET DFN=$PIECE(^SD(409.75,DA,0),U,1)
+4 IF 'DFN
QUIT
+5 DO PATDFN^SCDXUTL2(DFN)
+6 IF 'DFN
QUIT
+7 SET COD=$PIECE($GET(^SD(409.76,$EXTRACT(X,1,30),0)),U,1)
+8 IF COD']""
QUIT
+9 KILL ^SD(409.75,"ACOD",DFN,COD,DA)
+10 QUIT
