SDWLIFT2.m

SDWLIFT2 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY TRANSFER DETAILS  ; Compiled March 23, 2005 12:38:06  ; Compiled January 25, 2007 12:35:43

 ;;5.3;Scheduling;**415,446,1015**;AUG 13 1993;Build 21

 ;

 ;

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

 ;                             CHANGE LOG

 ;                                               

 ;   DATE                        PATCH                   DESCRIPTION

 ;   ----                        -----                   -----------

 ;

 ;

 Q

EN ; INITIALIZE VARIABLES FOR DISPLAY

 ; SDWLFMT: which set of data?

 ; 0 - Active

 ; 2 - Inactive

 N SDWLOK,SDWLI

 K SDWLINFO

 D GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)

 S SDWLIFTN=$$GETTN^SDWLIFT(.SDWLINFO)

 I 'SDWLIFTN S VALMBCK="R" Q

 K SDWLINFO D GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)

 S (SDWLOK,SDWLI)=0 F  S SDWLI=$O(SDWLINFO(SDWLI)) Q:'SDWLI  I SDWLINFO(SDWLI,1)=SDWLIFTN S SDWLOK=1 Q

 D:SDWLOK EN^VALM("SDWL TRANSFER REQ VIEW")

 D INIT^SDWLIFT1(SDWLFMT)

 S VALMBCK="R"

 Q

 ;

INIT ; Default initialization options.

 N DIC,D,X,WP,SDWLI,DFN,TMP,SDWLTY,SDWLDA,VADM

 S SDWLDA=$$GET1^DIQ(409.35,SDWLIFTN,.01,"I")

 D GETS^DIQ(409.35,SDWLIFTN,"1;3;7",,"TMP")

 S DFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")

 D DEM^VADPT

 S VALMCNT=1

 D SET^VALM10(VALMCNT,"Name: "_$E(VADM(1)_SDWLSPS,1,31)_"Status:        "_TMP(409.35,SDWLIFTN_",",3))

 I TMP(409.35,SDWLIFTN_",",7)'="" S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,"Transfer accepted by: "_TMP(409.35,SDWLIFTN_",",7))

 S VALMCNT=VALMCNT+1

 D SET^VALM10(VALMCNT,"SSN:  "_$E($P(VADM(2),U,2)_SDWLSPS,1,31)_"Date of birth: "_$P(VADM(3),U,2))

 S VALMCNT=VALMCNT+1

 D SET^VALM10(VALMCNT,"Wait List Type:  "_$$GET1^DIQ(409.3,SDWLDA,4)_" : "_$$GET1^DIQ(409.3,SDWLDA,4+$$GET1^DIQ(409.3,SDWLDA,4,"I")))

 S VALMCNT=VALMCNT+1

 D SET^VALM10(VALMCNT,"Transfer to: "_$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.35,SDWLIFTN_",",1),"D"),.01))

 S VALMCNT=VALMCNT+1

 D SET^VALM10(VALMCNT,"Comments: ")

 S X=$$GET1^DIQ(409.35,SDWLIFTN_",",5,"Z","WP")

 S SDWLI=0 F  S SDWLI=$O(WP(SDWLI)) Q:'SDWLI  S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,WP(SDWLI,0))

 Q

 ;

HD ; -- Make header line for list processor

 S X=$$SETSTR^VALM1("User: "_SDWLDZN,"",1,79)

 S VALMHDR(1)=X,VALMHDR(2)=""

 Q

EXIT ; Tidy up

 K SDWLIFTN

 K VALMHDR

 Q

SDWLIFT2  ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY TRANSFER DETAILS  ; Compiled March 23, 2005 12:38:06  ; Compiled January 25, 2007 12:35:43

 +1       ;;5.3;Scheduling;**415,446,1015**;AUG 13 1993;Build 21

 +2       ;

 +3       ;

 +4       ;******************************************************************

 +5       ;                             CHANGE LOG

 +6       ;                                               

 +7       ;   DATE                        PATCH                   DESCRIPTION

 +8       ;   ----                        -----                   -----------

 +9       ;

 +10      ;

 +11       QUIT 

EN        ; INITIALIZE VARIABLES FOR DISPLAY

 +1       ; SDWLFMT: which set of data?

 +2       ; 0 - Active

 +3       ; 2 - Inactive

 +4        NEW SDWLOK,SDWLI

 +5        KILL SDWLINFO

 +6        DO GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)

 +7        SET SDWLIFTN=$$GETTN^SDWLIFT(.SDWLINFO)

 +8        IF 'SDWLIFTN

               SET VALMBCK="R"

               QUIT 

 +9        KILL SDWLINFO

           DO GETDATA^SDWLIFT5(.SDWLINFO,SDWLFMT)

 +10       SET (SDWLOK,SDWLI)=0

           FOR 

               SET SDWLI=$ORDER(SDWLINFO(SDWLI))

               IF 'SDWLI

                   QUIT 

               IF SDWLINFO(SDWLI,1)=SDWLIFTN

                   SET SDWLOK=1

                   QUIT 

 +11       IF SDWLOK

               DO EN^VALM("SDWL TRANSFER REQ VIEW")

 +12       DO INIT^SDWLIFT1(SDWLFMT)

 +13       SET VALMBCK="R"

 +14       QUIT 

 +15      ;

INIT      ; Default initialization options.

 +1        NEW DIC,D,X,WP,SDWLI,DFN,TMP,SDWLTY,SDWLDA,VADM

 +2        SET SDWLDA=$$GET1^DIQ(409.35,SDWLIFTN,.01,"I")

 +3        DO GETS^DIQ(409.35,SDWLIFTN,"1;3;7",,"TMP")

 +4        SET DFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I")

 +5        DO DEM^VADPT

 +6        SET VALMCNT=1

 +7        DO SET^VALM10(VALMCNT,"Name: "_$EXTRACT(VADM(1)_SDWLSPS,1,31)_"Status:        "_TMP(409.35,SDWLIFTN_",",3))

 +8        IF TMP(409.35,SDWLIFTN_",",7)'=""

               SET VALMCNT=VALMCNT+1

               DO SET^VALM10(VALMCNT,"Transfer accepted by: "_TMP(409.35,SDWLIFTN_",",7))

 +9        SET VALMCNT=VALMCNT+1

 +10       DO SET^VALM10(VALMCNT,"SSN:  "_$EXTRACT($PIECE(VADM(2),U,2)_SDWLSPS,1,31)_"Date of birth: "_$PIECE(VADM(3),U,2))

 +11       SET VALMCNT=VALMCNT+1

 +12       DO SET^VALM10(VALMCNT,"Wait List Type:  "_$$GET1^DIQ(409.3,SDWLDA,4)_" : "_$$GET1^DIQ(409.3,SDWLDA,4+$$GET1^DIQ(409.3,SDWLDA,4,"I")))

 +13       SET VALMCNT=VALMCNT+1

 +14       DO SET^VALM10(VALMCNT,"Transfer to: "_$$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.35,SDWLIFTN_",",1),"D"),.01))

 +15       SET VALMCNT=VALMCNT+1

 +16       DO SET^VALM10(VALMCNT,"Comments: ")

 +17       SET X=$$GET1^DIQ(409.35,SDWLIFTN_",",5,"Z","WP")

 +18       SET SDWLI=0

           FOR 

               SET SDWLI=$ORDER(WP(SDWLI))

               IF 'SDWLI

                   QUIT 

               SET VALMCNT=VALMCNT+1

               DO SET^VALM10(VALMCNT,WP(SDWLI,0))

 +19       QUIT 

 +20      ;

HD        ; -- Make header line for list processor

 +1        SET X=$$SETSTR^VALM1("User: "_SDWLDZN,"",1,79)

 +2        SET VALMHDR(1)=X

           SET VALMHDR(2)=""

 +3        QUIT 

EXIT      ; Tidy up

 +1        KILL SDWLIFTN

 +2        KILL VALMHDR

 +3        QUIT