SDWLRP3 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 3 ; 20 Aug 2002 2:10 PM
;;5.3;scheduling;**263**;AUG 13 1993
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
; 10/30/2002 Inserted comment for DBIA174
;
;
;
;
;
;
;******************************************************************
;
;
; Internal ID : Description ; Internal ID : Description
;
;
SDPRIOUT() ;PRIORITY SET OF CODES - Internal ID:Description;Internal ID:Description
K ^TMP("SDWLST",$J)
D FIELD^DID(409.3,"10",,"POINTER","^TMP(""SDWLPRI"",$J)")
Q
SDREQOUT() ;REQUEST BY SET OF CODES - Internal ID:Description;Internal ID:Description
K ^TMP("SDWLST",$J)
D FIELD^DID(409.3,"11",,"POINTER","^TMP(""SDWLREQ"",$J)")
Q
SDTYOUT() ;WAIT LIST TYPE - Internal ID:Description;Internal ID:Description
K ^TMP("SDWLST",$J)
D FIELD^DID(409.3,"4",,"POINTER","^TMP(""SDWLTY"",$J)")
Q
SDDISOUT() ;DISPOSITION
K ^TMP("SDWLDIS",$J)
D FIELD^DID(409.3,"21",,"POINTER","^TMP(""SDWLDIS"",$J)")
Q
SDSTOUT() ;CURRENT STATUS
K ^TMP("SDWLST",$J)
D FIELD^DID(409.3,"23",,"POINTER","^TMP(""SDWLST"",$J)")
Q
SDPACOUT() ;PACKAGE
K ^TMP("SDWPAC",$J)
D FIELD^DID(409.3,"26",,"POINTER","^TMP(""SDWLPAC"",$J)")
Q
SDNEOUT() ;NEW ENROLLEE
K ^TMP("SDWLNE",$J)
D FIELD^DID(409.3,"27",,"POINTER","^TMP(""SDWLNE"",$J)")
Q
SDSC(SDWLOUT,SDWLDFN) ;-service connected API
;
;
; Input:
; Patients DFN
;
; Output:
; ^TMP("SDWLRP3",$J,0)=Service Connected Disability %
; ^TMP("SDWLRP3",$J,INTERNAL NUMBER)=DISABILITY^%
;
;
K ^TMP("SDWLRP3",$J)
D ELIG^VADPT,SVC^VADPT
I $D(VAEL(3)),$P(VAEL(3),U,2) S SDWLSC=$P(VAEL(3),U,2),^TMP("SDWLRP3",$J,0)=SDWLSC
;
;10/30/2002;DBIA174 - Direct global access to Patient file, Field .3721 -- Rated Disabilties-teh
;
I $D(^DPT(SDWLDFN,.372)) S X=0 F S X=$O(^DPT(SDWLDFN,.372,X)) Q:X<1 D
.S Y=$G(^DPT(SDWLDFN,.372,X,0)) I $P(Y,U,3) S SDWLX=$P($G(^DIC(31,+Y,0)),U,1),^TMP("SDWLRP3",$J,$P(Y,U,1))=SDWLX_"^"_$P(Y,U,2)
I '$D(^TMP("SDWLRP3",$J)) S SDWLOUT=-1 Q
K SDWLOUT S SDWLOUT=$NA(^TMP("SDWLRP3",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRP3 2486 printed Nov 22, 2024@18:13:07 Page 2
SDWLRP3 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 3 ; 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/30/2002 Inserted comment for DBIA174
+10 ;
+11 ;
+12 ;
+13 ;
+14 ;
+15 ;
+16 ;******************************************************************
+17 ;
+18 ;
+19 ; Internal ID : Description ; Internal ID : Description
+20 ;
+21 ;
SDPRIOUT() ;PRIORITY SET OF CODES - Internal ID:Description;Internal ID:Description
+1 KILL ^TMP("SDWLST",$JOB)
+2 DO FIELD^DID(409.3,"10",,"POINTER","^TMP(""SDWLPRI"",$J)")
+3 QUIT
SDREQOUT() ;REQUEST BY SET OF CODES - Internal ID:Description;Internal ID:Description
+1 KILL ^TMP("SDWLST",$JOB)
+2 DO FIELD^DID(409.3,"11",,"POINTER","^TMP(""SDWLREQ"",$J)")
+3 QUIT
SDTYOUT() ;WAIT LIST TYPE - Internal ID:Description;Internal ID:Description
+1 KILL ^TMP("SDWLST",$JOB)
+2 DO FIELD^DID(409.3,"4",,"POINTER","^TMP(""SDWLTY"",$J)")
+3 QUIT
SDDISOUT() ;DISPOSITION
+1 KILL ^TMP("SDWLDIS",$JOB)
+2 DO FIELD^DID(409.3,"21",,"POINTER","^TMP(""SDWLDIS"",$J)")
+3 QUIT
SDSTOUT() ;CURRENT STATUS
+1 KILL ^TMP("SDWLST",$JOB)
+2 DO FIELD^DID(409.3,"23",,"POINTER","^TMP(""SDWLST"",$J)")
+3 QUIT
SDPACOUT() ;PACKAGE
+1 KILL ^TMP("SDWPAC",$JOB)
+2 DO FIELD^DID(409.3,"26",,"POINTER","^TMP(""SDWLPAC"",$J)")
+3 QUIT
SDNEOUT() ;NEW ENROLLEE
+1 KILL ^TMP("SDWLNE",$JOB)
+2 DO FIELD^DID(409.3,"27",,"POINTER","^TMP(""SDWLNE"",$J)")
+3 QUIT
SDSC(SDWLOUT,SDWLDFN) ;-service connected API
+1 ;
+2 ;
+3 ; Input:
+4 ; Patients DFN
+5 ;
+6 ; Output:
+7 ; ^TMP("SDWLRP3",$J,0)=Service Connected Disability %
+8 ; ^TMP("SDWLRP3",$J,INTERNAL NUMBER)=DISABILITY^%
+9 ;
+10 ;
+11 KILL ^TMP("SDWLRP3",$JOB)
+12 DO ELIG^VADPT
DO SVC^VADPT
+13 IF $DATA(VAEL(3))
IF $PIECE(VAEL(3),U,2)
SET SDWLSC=$PIECE(VAEL(3),U,2)
SET ^TMP("SDWLRP3",$JOB,0)=SDWLSC
+14 ;
+15 ;10/30/2002;DBIA174 - Direct global access to Patient file, Field .3721 -- Rated Disabilties-teh
+16 ;
+17 IF $DATA(^DPT(SDWLDFN,.372))
SET X=0
FOR
SET X=$ORDER(^DPT(SDWLDFN,.372,X))
if X<1
QUIT
Begin DoDot:1
+18 SET Y=$GET(^DPT(SDWLDFN,.372,X,0))
IF $PIECE(Y,U,3)
SET SDWLX=$PIECE($GET(^DIC(31,+Y,0)),U,1)
SET ^TMP("SDWLRP3",$JOB,$PIECE(Y,U,1))=SDWLX_"^"_$PIECE(Y,U,2)
End DoDot:1
+19 IF '$DATA(^TMP("SDWLRP3",$JOB))
SET SDWLOUT=-1
QUIT
+20 KILL SDWLOUT
SET SDWLOUT=$NAME(^TMP("SDWLRP3",$JOB))
+21 QUIT
