SDWLRP2 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 2;06/28/2002 ; 20 Aug 2002 2:10 PM
;;5.3;scheduling;**263**;AUG 13 1993
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
;
OUTIN(SDWLOUT) ;List entries in INSTITUTION file (#4)
;
; Output:
; SDWLOUT - The return reference
;
; ^TMP("SDWLRP2",$J,INSTITUTION IEN)=ZERO NODE DATA
;
N SDWL1,SDWL2,SDWL3
K ^TMP("SDWLRP2",$J)
S U="^",SDWL1="" F S SDWL1=$O(^DIC(4,"B",SDWL1)) Q:SDWL1="" D
.S SDWL2="" F S SDWL2=$O(^DIC(4,"B",SDWL1,SDWL2)) Q:SDWL2="" D
..S SDWL3=$G(^DIC(4,SDWL2,0)),^TMP("SDWLRP2",$J,SDWL1,SDWL2)=SDWL1_U_SDWL3
S SDWLOUT=$NA(^TMP("SDWLRP2",$J))
Q
OUTSC0(SDWLOUT) ;List entries in CLINIC file (#409.32) - No Screen
;
; Output:
; SDWLOUT = ^TMP("DILIST",$J)
;
; IEN^
;
N DIERR
D LIST^DIC(409.32,,".01;","PS")
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT S SDWLOUT=$NA(^TMP("DILIST",$J))
Q
OUTSC1(SDWLOUT,SDWLIN) ;List entries in CLINIC file (#409.32) - Screen with Institution
;
; Output:
; SDWLOUT = ^TMP("DILIST",$J)
;
; IEN^
;
N SDWLDA,SDWLIN,SDWLSCR,DIERR
S SDWLSCR="I $P(^(0),U,6)=SDWLIN"
S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.32,SDWLDA)) Q:SDWLDA<1 D
.S SDWLDAX="`"_SDWLDA
.D LIST^DIC(409.32,,".01;.02IE;1IE;2;3;4","PS",500,.SDWLDAX,,,.SDWLSCR)
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT,SDWLDA,SDWLIN,SDWLSCR S SDWLOUT="^TMP(""DILIST"","_$J_")"
Q
OUTSC2(SDWLOUT) ;List entries in HOSPITAL LOCATION FILE (#44)
;
; Output:
; SDWLOUT = ^TMP("DILIST",$J)
;
; IEN^
;
N DIERR
S SDWLSCR="I $E($P(^DIC(4,+Y,0),U,1),1,2)'=""ZZ"""
S SDWLDA=0 F S SDWLDA=$O(^SC(SDWLDA)) Q:SDWLDA<1 D
.S SDWLDAX="`"_SDWLDA
.D LIST^DIC(44,,".01","PS",500,.SDWLDAX,,,.SDWLSCR)
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
Q
OUTST(SDWLOUT) ;List entries in Team File (#404.51)
;
; Output:
; SCDWLOUT = ^TMP("DILIST",$J)
;
; IEN^NAME
; 1 2
N DIERR
D LIST^DIC(404.51,,".01;","PS")
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
Q
OUTSP(SDWLOUT) ;List entries in TEAM POSITION FILE (#404.57)
;
; Output:
; SCDWLOUT = ^TMP("DILIST",$J)
;
; IEN^NAME
; 1 2
N DIERR
D LIST^DIC(404.57,,"@;.01;","PS")
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
Q
OUTSS(SDWLOUT) ;List entries in WL SERVICE/SPECIALTY file (#409.31)
;
; Output:
; SCDWLOUT = ^TMP("DILIST",$J)
;
; IEN^NAME
; 1 2
N DIERR
D LIST^DIC(409.31,,"@;.01;","PS")
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
Q
OUTPROV(SDWLOUT) ;List entries in NEW PERSON FILE (#200) - Screen by Class
;
; Output:
; SCDWLOUT = ^TMP("DILIST",$J)
;
; IEN^NAME
; 1 2
;
N SDWLDA,SDWLSCR,DIERR S SDWLSCR=""
S SDWLDA=0 F S SDWLDA=$O(^SCTM(404.51,SDWLDA)) Q:SDWLDA<1 D
.S SDWLDAX="`"_SDWLDA
.D LIST^DIC(404.51,,".01;","PS",,.SDWLDAX)
I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
Q
OUTSITE(SDWLOUT) ;return site name and number
;
; Output
; SDWLOUT = SITE NAME^IE
S U="^"
S SDWLOUT=$P(^DIC(4,+$G(^DD("SITE",0)),0),U)_U_$G(^DD("SITE",0))
Q SDWLOUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRP2 3737 printed Oct 16, 2024@19:03:37 Page 2
SDWLRP2 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 2;06/28/2002 ; 20 Aug 2002 2:10 PM
+1 ;;5.3;scheduling;**263**;AUG 13 1993
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ;
OUTIN(SDWLOUT) ;List entries in INSTITUTION file (#4)
+1 ;
+2 ; Output:
+3 ; SDWLOUT - The return reference
+4 ;
+5 ; ^TMP("SDWLRP2",$J,INSTITUTION IEN)=ZERO NODE DATA
+6 ;
+7 NEW SDWL1,SDWL2,SDWL3
+8 KILL ^TMP("SDWLRP2",$JOB)
+9 SET U="^"
SET SDWL1=""
FOR
SET SDWL1=$ORDER(^DIC(4,"B",SDWL1))
if SDWL1=""
QUIT
Begin DoDot:1
+10 SET SDWL2=""
FOR
SET SDWL2=$ORDER(^DIC(4,"B",SDWL1,SDWL2))
if SDWL2=""
QUIT
Begin DoDot:2
+11 SET SDWL3=$GET(^DIC(4,SDWL2,0))
SET ^TMP("SDWLRP2",$JOB,SDWL1,SDWL2)=SDWL1_U_SDWL3
End DoDot:2
End DoDot:1
+12 SET SDWLOUT=$NAME(^TMP("SDWLRP2",$JOB))
+13 QUIT
OUTSC0(SDWLOUT) ;List entries in CLINIC file (#409.32) - No Screen
+1 ;
+2 ; Output:
+3 ; SDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^
+6 ;
+7 NEW DIERR
+8 DO LIST^DIC(409.32,,".01;","PS")
+9 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+10 KILL SDWLOUT
SET SDWLOUT=$NAME(^TMP("DILIST",$JOB))
+11 QUIT
OUTSC1(SDWLOUT,SDWLIN) ;List entries in CLINIC file (#409.32) - Screen with Institution
+1 ;
+2 ; Output:
+3 ; SDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^
+6 ;
+7 NEW SDWLDA,SDWLIN,SDWLSCR,DIERR
+8 SET SDWLSCR="I $P(^(0),U,6)=SDWLIN"
+9 SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^SDWL(409.32,SDWLDA))
if SDWLDA<1
QUIT
Begin DoDot:1
+10 SET SDWLDAX="`"_SDWLDA
+11 DO LIST^DIC(409.32,,".01;.02IE;1IE;2;3;4","PS",500,.SDWLDAX,,,.SDWLSCR)
End DoDot:1
+12 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+13 KILL SDWLOUT,SDWLDA,SDWLIN,SDWLSCR
SET SDWLOUT="^TMP(""DILIST"","_$JOB_")"
+14 QUIT
OUTSC2(SDWLOUT) ;List entries in HOSPITAL LOCATION FILE (#44)
+1 ;
+2 ; Output:
+3 ; SDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^
+6 ;
+7 NEW DIERR
+8 SET SDWLSCR="I $E($P(^DIC(4,+Y,0),U,1),1,2)'=""ZZ"""
+9 SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^SC(SDWLDA))
if SDWLDA<1
QUIT
Begin DoDot:1
+10 SET SDWLDAX="`"_SDWLDA
+11 DO LIST^DIC(44,,".01","PS",500,.SDWLDAX,,,.SDWLSCR)
End DoDot:1
+12 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+13 KILL SDWLOUT,SDWLDA
SET SDWLOUT=$NAME(^TMP("DILIST",$JOB))
+14 QUIT
OUTST(SDWLOUT) ;List entries in Team File (#404.51)
+1 ;
+2 ; Output:
+3 ; SCDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^NAME
+6 ; 1 2
+7 NEW DIERR
+8 DO LIST^DIC(404.51,,".01;","PS")
+9 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+10 KILL SDWLOUT,SDWLDA
SET SDWLOUT=$NAME(^TMP("DILIST",$JOB))
+11 QUIT
OUTSP(SDWLOUT) ;List entries in TEAM POSITION FILE (#404.57)
+1 ;
+2 ; Output:
+3 ; SCDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^NAME
+6 ; 1 2
+7 NEW DIERR
+8 DO LIST^DIC(404.57,,"@;.01;","PS")
+9 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+10 KILL SDWLOUT,SDWLDA
SET SDWLOUT=$NAME(^TMP("DILIST",$JOB))
+11 QUIT
OUTSS(SDWLOUT) ;List entries in WL SERVICE/SPECIALTY file (#409.31)
+1 ;
+2 ; Output:
+3 ; SCDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^NAME
+6 ; 1 2
+7 NEW DIERR
+8 DO LIST^DIC(409.31,,"@;.01;","PS")
+9 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+10 KILL SDWLOUT,SDWLDA
SET SDWLOUT=$NAME(^TMP("DILIST",$JOB))
+11 QUIT
OUTPROV(SDWLOUT) ;List entries in NEW PERSON FILE (#200) - Screen by Class
+1 ;
+2 ; Output:
+3 ; SCDWLOUT = ^TMP("DILIST",$J)
+4 ;
+5 ; IEN^NAME
+6 ; 1 2
+7 ;
+8 NEW SDWLDA,SDWLSCR,DIERR
SET SDWLSCR=""
+9 SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^SCTM(404.51,SDWLDA))
if SDWLDA<1
QUIT
Begin DoDot:1
+10 SET SDWLDAX="`"_SDWLDA
+11 DO LIST^DIC(404.51,,".01;","PS",,.SDWLDAX)
End DoDot:1
+12 IF $GET(DIERR)
DO CLEAN^DILF
SET RESULT=0
QUIT
+13 KILL SDWLOUT,SDWLDA
SET SDWLOUT=$NAME(^TMP("DILIST",$JOB))
+14 QUIT
OUTSITE(SDWLOUT) ;return site name and number
+1 ;
+2 ; Output
+3 ; SDWLOUT = SITE NAME^IE
+4 SET U="^"
+5 SET SDWLOUT=$PIECE(^DIC(4,+$GET(^DD("SITE",0)),0),U)_U_$GET(^DD("SITE",0))
+6 QUIT SDWLOUT
