- 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 Feb 19, 2025@00:29:44 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