SDWLRP3.m

SDWLRP3 ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 3 ; 20 Aug 2002  2:10 PM

 ;;5.3;scheduling;**263,1015**;AUG 13 1993;Build 21

 ;

 ;

 ;******************************************************************

 ;                             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

SDWLRP3   ;;IOFO BAY PINES/TEH - WAITING LIST - RPC 3 ; 20 Aug 2002  2:10 PM

 +1       ;;5.3;scheduling;**263,1015**;AUG 13 1993;Build 21

 +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