Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDWLRP2

SDWLRP2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;******************************************************************
  1. ; CHANGE LOG
  1. ;
  1. ; DATE PATCH DESCRIPTION
  1. ; ---- ----- -----------
  1. ;
  1. ;
  1. ;
  1. OUTIN(SDWLOUT) ;List entries in INSTITUTION file (#4)
  1. ;
  1. ; Output:
  1. ; SDWLOUT - The return reference
  1. ;
  1. ; ^TMP("SDWLRP2",$J,INSTITUTION IEN)=ZERO NODE DATA
  1. ;
  1. N SDWL1,SDWL2,SDWL3
  1. K ^TMP("SDWLRP2",$J)
  1. S U="^",SDWL1="" F S SDWL1=$O(^DIC(4,"B",SDWL1)) Q:SDWL1="" D
  1. .S SDWL2="" F S SDWL2=$O(^DIC(4,"B",SDWL1,SDWL2)) Q:SDWL2="" D
  1. ..S SDWL3=$G(^DIC(4,SDWL2,0)),^TMP("SDWLRP2",$J,SDWL1,SDWL2)=SDWL1_U_SDWL3
  1. S SDWLOUT=$NA(^TMP("SDWLRP2",$J))
  1. Q
  1. OUTSC0(SDWLOUT) ;List entries in CLINIC file (#409.32) - No Screen
  1. ;
  1. ; Output:
  1. ; SDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^
  1. ;
  1. N DIERR
  1. D LIST^DIC(409.32,,".01;","PS")
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT S SDWLOUT=$NA(^TMP("DILIST",$J))
  1. Q
  1. OUTSC1(SDWLOUT,SDWLIN) ;List entries in CLINIC file (#409.32) - Screen with Institution
  1. ;
  1. ; Output:
  1. ; SDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^
  1. ;
  1. N SDWLDA,SDWLIN,SDWLSCR,DIERR
  1. S SDWLSCR="I $P(^(0),U,6)=SDWLIN"
  1. S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.32,SDWLDA)) Q:SDWLDA<1 D
  1. .S SDWLDAX="`"_SDWLDA
  1. .D LIST^DIC(409.32,,".01;.02IE;1IE;2;3;4","PS",500,.SDWLDAX,,,.SDWLSCR)
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT,SDWLDA,SDWLIN,SDWLSCR S SDWLOUT="^TMP(""DILIST"","_$J_")"
  1. Q
  1. OUTSC2(SDWLOUT) ;List entries in HOSPITAL LOCATION FILE (#44)
  1. ;
  1. ; Output:
  1. ; SDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^
  1. ;
  1. N DIERR
  1. S SDWLSCR="I $E($P(^DIC(4,+Y,0),U,1),1,2)'=""ZZ"""
  1. S SDWLDA=0 F S SDWLDA=$O(^SC(SDWLDA)) Q:SDWLDA<1 D
  1. .S SDWLDAX="`"_SDWLDA
  1. .D LIST^DIC(44,,".01","PS",500,.SDWLDAX,,,.SDWLSCR)
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
  1. Q
  1. OUTST(SDWLOUT) ;List entries in Team File (#404.51)
  1. ;
  1. ; Output:
  1. ; SCDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^NAME
  1. ; 1 2
  1. N DIERR
  1. D LIST^DIC(404.51,,".01;","PS")
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
  1. Q
  1. OUTSP(SDWLOUT) ;List entries in TEAM POSITION FILE (#404.57)
  1. ;
  1. ; Output:
  1. ; SCDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^NAME
  1. ; 1 2
  1. N DIERR
  1. D LIST^DIC(404.57,,"@;.01;","PS")
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
  1. Q
  1. OUTSS(SDWLOUT) ;List entries in WL SERVICE/SPECIALTY file (#409.31)
  1. ;
  1. ; Output:
  1. ; SCDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^NAME
  1. ; 1 2
  1. N DIERR
  1. D LIST^DIC(409.31,,"@;.01;","PS")
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
  1. Q
  1. OUTPROV(SDWLOUT) ;List entries in NEW PERSON FILE (#200) - Screen by Class
  1. ;
  1. ; Output:
  1. ; SCDWLOUT = ^TMP("DILIST",$J)
  1. ;
  1. ; IEN^NAME
  1. ; 1 2
  1. ;
  1. N SDWLDA,SDWLSCR,DIERR S SDWLSCR=""
  1. S SDWLDA=0 F S SDWLDA=$O(^SCTM(404.51,SDWLDA)) Q:SDWLDA<1 D
  1. .S SDWLDAX="`"_SDWLDA
  1. .D LIST^DIC(404.51,,".01;","PS",,.SDWLDAX)
  1. I $G(DIERR) D CLEAN^DILF S RESULT=0 Q
  1. K SDWLOUT,SDWLDA S SDWLOUT=$NA(^TMP("DILIST",$J))
  1. Q
  1. OUTSITE(SDWLOUT) ;return site name and number
  1. ;
  1. ; Output
  1. ; SDWLOUT = SITE NAME^IE
  1. S U="^"
  1. S SDWLOUT=$P(^DIC(4,+$G(^DD("SITE",0)),0),U)_U_$G(^DD("SITE",0))
  1. Q SDWLOUT