SDWLIFT7 ; bp-oifo/og ; Print reports ; Compiled April 11, 2005 16:10:09
;;5.3;Scheduling;**415**;AUG 13 1993
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
; Print coversheet, dialog.
D DIALOG("EN1^"_$T(+0),"SDWL TRANSFER COVERSHEET")
S VALMBCK="R"
Q
REQS ; All transfer requests
N SDWLSPS ; Required as this is called from a menu option.
S SDWLSPS=$J("",80)
D DIALOG("EN2^"_$T(+0),"SDWL TRANSFER PRINT REQUESTS")
Q
HEAD ; Write header.
S SDWLLINE=3,SDWLPAGE=SDWLPAGE+1
W !?80-$L(SDWLTTL)\2,SDWLTTL,?75-$L(SDWLPAGE),"PAGE ",SDWLPAGE,!
Q
EN1 ; Print coversheet.
N SDWLTTL,SDWLINFO,SDWLPAGE,SDWLLINE,SDWLI
D GETINFO^SDWLIFT6(.SDWLINFO)
S SDWLTTL="SDWL TRANSFER - COVERSHEET",SDWLPAGE=0
D HEAD
F SDWLI=1:1:SDWLINFO(0) D
.S SDWLLINE=SDWLLINE+1
.I SDWLLINE+3>IOSL D HEAD
.W !,SDWLINFO(SDWLI,0)
.Q
Q
EN2 ; Print requests
N SDWLINFO,SDWLTTL,SDWLPAGE,SDWLLINE,SDWLI
D GETDATA^SDWLIFT5(.SDWLINFO,1)
S SDWLTTL="SDWL TRANSFER - TRANSFER REQUESTS",SDWLPAGE=0
D HEAD
F SDWLI=1:1:SDWLINFO(0) D
.I SDWLLINE+8>IOSL D HEAD
.W !,"Name: ",$E($P(SDWLINFO(SDWLI,0),U)_SDWLSPS,1,32)
.W "Sex: ",$P(SDWLINFO(SDWLI,0),U,8)
.W " SSN: ",$E($P(SDWLINFO(SDWLI,0),U,2)_SDWLSPS,1,14)
.W !,"Wait List Type: ",$P(SDWLINFO(SDWLI,0),U,6)
.W " : ",$P(SDWLINFO(SDWLI,0),U,7)
.W !,"Status: ",$E($P(SDWLINFO(SDWLI,0),U,4)_SDWLSPS,1,14)
.W "Transmission time: ",$P(SDWLINFO(SDWLI,0),U,9)
.W !,"Requestor: ",$P(SDWLINFO(SDWLI,0),U,10),!
.S SDWLLINE=SDWLLINE+5
.Q
Q
DIALOG(ZTRTN,SDWLDESC) ; Required variable - SDWLIFTN: SDWL Transfer id.
N DIE,DA,DR
K %ZIS,IOP,POP,ZTSK,SDWLIO
S ZTDESC=SDWLDESC
D FULL^VALM1
S SDWLIO=ION,%ZIS="Q"
D ^%ZIS
K %ZIS
S IOM=80
I POP D ; Do-dots preserve $T
.S IOP=SDWLIO
.D ^%ZIS
.K IOP,SDWLIO
.W !,"Please try later!"
.Q
E D I $G(SDWLDESC)="SDWL TRANSFER COVERSHEET" S DIE="^SDWL(409.36,",DA=SDWLIFTN,DR=".3///Y" D ^DIE
.K SDDIO
.I '$D(IO("Q")) D @ZTRTN Q
.K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
.S ZTDTH=$H S:$D(SDWLIFTN) ZTSAVE("SDWLIFTN")=SDWLIFTN,ZTSAVE("SDWLSPS")=SDWLSPS
.D ^%ZTLOAD W:$D(ZTSK) !,"Report is queued to print !!" K ZTSK
.Q
END ; Tidy up.
W ! D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLIFT7 2465 printed Apr 09, 2024@21:54:12 Page 2
SDWLIFT7 ; bp-oifo/og ; Print reports ; Compiled April 11, 2005 16:10:09
+1 ;;5.3;Scheduling;**415**;AUG 13 1993
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ; Print coversheet, dialog.
+12 DO DIALOG("EN1^"_$TEXT(+0),"SDWL TRANSFER COVERSHEET")
+13 SET VALMBCK="R"
+14 QUIT
REQS ; All transfer requests
+1 ; Required as this is called from a menu option.
NEW SDWLSPS
+2 SET SDWLSPS=$JUSTIFY("",80)
+3 DO DIALOG("EN2^"_$TEXT(+0),"SDWL TRANSFER PRINT REQUESTS")
+4 QUIT
HEAD ; Write header.
+1 SET SDWLLINE=3
SET SDWLPAGE=SDWLPAGE+1
+2 WRITE !?80-$LENGTH(SDWLTTL)\2,SDWLTTL,?75-$LENGTH(SDWLPAGE),"PAGE ",SDWLPAGE,!
+3 QUIT
EN1 ; Print coversheet.
+1 NEW SDWLTTL,SDWLINFO,SDWLPAGE,SDWLLINE,SDWLI
+2 DO GETINFO^SDWLIFT6(.SDWLINFO)
+3 SET SDWLTTL="SDWL TRANSFER - COVERSHEET"
SET SDWLPAGE=0
+4 DO HEAD
+5 FOR SDWLI=1:1:SDWLINFO(0)
Begin DoDot:1
+6 SET SDWLLINE=SDWLLINE+1
+7 IF SDWLLINE+3>IOSL
DO HEAD
+8 WRITE !,SDWLINFO(SDWLI,0)
+9 QUIT
End DoDot:1
+10 QUIT
EN2 ; Print requests
+1 NEW SDWLINFO,SDWLTTL,SDWLPAGE,SDWLLINE,SDWLI
+2 DO GETDATA^SDWLIFT5(.SDWLINFO,1)
+3 SET SDWLTTL="SDWL TRANSFER - TRANSFER REQUESTS"
SET SDWLPAGE=0
+4 DO HEAD
+5 FOR SDWLI=1:1:SDWLINFO(0)
Begin DoDot:1
+6 IF SDWLLINE+8>IOSL
DO HEAD
+7 WRITE !,"Name: ",$EXTRACT($PIECE(SDWLINFO(SDWLI,0),U)_SDWLSPS,1,32)
+8 WRITE "Sex: ",$PIECE(SDWLINFO(SDWLI,0),U,8)
+9 WRITE " SSN: ",$EXTRACT($PIECE(SDWLINFO(SDWLI,0),U,2)_SDWLSPS,1,14)
+10 WRITE !,"Wait List Type: ",$PIECE(SDWLINFO(SDWLI,0),U,6)
+11 WRITE " : ",$PIECE(SDWLINFO(SDWLI,0),U,7)
+12 WRITE !,"Status: ",$EXTRACT($PIECE(SDWLINFO(SDWLI,0),U,4)_SDWLSPS,1,14)
+13 WRITE "Transmission time: ",$PIECE(SDWLINFO(SDWLI,0),U,9)
+14 WRITE !,"Requestor: ",$PIECE(SDWLINFO(SDWLI,0),U,10),!
+15 SET SDWLLINE=SDWLLINE+5
+16 QUIT
End DoDot:1
+17 QUIT
DIALOG(ZTRTN,SDWLDESC) ; Required variable - SDWLIFTN: SDWL Transfer id.
+1 NEW DIE,DA,DR
+2 KILL %ZIS,IOP,POP,ZTSK,SDWLIO
+3 SET ZTDESC=SDWLDESC
+4 DO FULL^VALM1
+5 SET SDWLIO=ION
SET %ZIS="Q"
+6 DO ^%ZIS
+7 KILL %ZIS
+8 SET IOM=80
+9 ; Do-dots preserve $T
IF POP
Begin DoDot:1
+10 SET IOP=SDWLIO
+11 DO ^%ZIS
+12 KILL IOP,SDWLIO
+13 WRITE !,"Please try later!"
+14 QUIT
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 KILL SDDIO
+17 IF '$DATA(IO("Q"))
DO @ZTRTN
QUIT
+18 KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
+19 SET ZTDTH=$HOROLOG
if $DATA(SDWLIFTN)
SET ZTSAVE("SDWLIFTN")=SDWLIFTN
SET ZTSAVE("SDWLSPS")=SDWLSPS
+20 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report is queued to print !!"
KILL ZTSK
+21 QUIT
End DoDot:1
IF $GET(SDWLDESC)="SDWL TRANSFER COVERSHEET"
SET DIE="^SDWL(409.36,"
SET DA=SDWLIFTN
SET DR=".3///Y"
DO ^DIE
END ; Tidy up.
+1 WRITE !
DO ^%ZISC
+2 QUIT
